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1.0  introduction 
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[ie-NR3j  IR  System  1  is  an  automated  optical  bench  designed  for  the 
measurement  of  spectral  attenuation,  differential  modal  attenuation,  and 
numerical  aperture  of  rirconium  fluoride  infrared  optical  fiber.  I^was 
developed  by  the  fiber  &  EJeetro^Gptics  Researcli  CeHter^rVifgima  Tech 
under  contract  to  NRL,  an^is  a  specially  adapted  version  of  a  commercially 
available  FOA-2000,  a  silica  fiber  characterication  system  manufactured  by 
Photon  Kinetics  of  Beaverton,  Oregon. 

1.1  Measurements  performed  by  the  NRL  IR  System  1 

1.1.1  Spectral  Attenuation  _ 

The  system  measures  spectral  attenuation  over  the  range  from  600  mn  to 
Launch  conditions  are  overfilled  for  multimode  fibers  with  core 
"  ‘diameters  up  to  150jljp5?and  with  numerical  apertures  up  to  0.24.  The  fiber 
j  vacuum  chucks.fian^accept  fibers  with  outside  diameters  up  to  200;;3|im.  The 
■  attenuatioltfis  derived  by  performing  a  cut-back  test, 


1.1.2  Differential  Modal  Attenuation 


The  system  can  measure  differential  modal  attenuation  (DMA)  on  step-index 
multiro.ode  fibers.  Launch  conditions  are  restricted  by  manually  placing 
apertures  that  restrict  the  lauiich  num.erical  aperture  (NA)  to  a  narrow 
range,  thereby  exciting  a  limited  mode  group  in  the  optical  fiber.  Attenuation 
values  are  derived  by  performing  a  cutback  test.  The  DMA  apertures  and  the 
range  of  NA  for  each  aperture  follows: 

ApMijir.e.-# 

NA  Range 

#1 

.04 

#2 

.08 

#3 

.10 

#4 

.13 

#5 

.15 

#6 

.18 

#7 

.20 

#8 

.04<NA<.08 

#9 

,08<NA<.13 

#10 

.11<NA<.17 

#11 

.14<NA<.21 

DMA  tests  for  graded-index  fibers  have  not  been  implemented  m  the  cur*  Caai. 
version  of  the  system  software,  but  the  system  may  be  easily  adapted  for  this 
tsst.  In  order  to  achieve  the  correct  restricted  launch  for  graded  index  fibers. 
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the  launch  spot  size  must  be  restricted  as  well  as  the  numerical  aperture.  To 
restrict  the  spot  size,  an  aperture  of  the  correct  diameter  must  be  placed  in 
the  spot  restrictor  carriage  holder  (see  Figures  1  and  2),  and  the  DMA 
software  must  be  changed  to  engage  the  spot  restrictor.  The  spot  restrictor 
aperture  is  demagnified  100/9  times  when  it  is  imaged  onto  the  input  fiber 
end.  The  current  spot  restrictor  aperture  (390  firn  diameter)  achieves  a  spot 
size  of  35  pm  on  the  end  of  the  fiber.  This  represents  the  minimum  spot 
achievable  at  2.5  pm  wavelength  since  it  is  approximately  the  diffraction 
limit  for  the  infrared  lenses  at  that  wavelength. 

1.1.3  Numerical  Aperture 

The  system  will  measure  the  numerical  aperture  of  step  and  graded-index 
fibers,  up  to  a  value  of  0.24.  Due  to  the  low  radiance  of  the  lamp  source,  the 
measurement  procedure  uses  a  scanning  knife-edge,  rather  than  a  scanning 
aperture  in  the  far-field  as  specified  in  EIA  FOTP  #47,  The  knife  edge 
technique  is  an  adaptation  of  an  EIA  procedure  for  determining  the  mode 
field  diameter  of  a  single  mode  fiber.  In  this  procedure,  a  knife  edge  is 
scanned  across  the  far  field  output  of  the  fiber,  and  a  lens  is  used  to  collect  the 
light  passed  by  the  knife  edge  and  direct  it  to  the  detector.  The  computer 
reads  the  output  of  the  detector  at  the  lock-in  amplifier,  which  is  effectively 
the  integrated  power  as  a  function  of  far  field  angle.  This  data  is  then 
differentiated  and  smoothed  to  yield  the  far  field  radiation  pattern  of  the  fiber. 
From  this  far  field  the  numerical  aperture  is  derived.  A  criterion  of  5%  of 
maximum  intensity  is  used  to  determine  the  numerical  aperture. 

1.2  System  specifications 

1.2.1.  Fiber  limitations 

The  system  provides  overfilled  launch  conditions  for  multimode  fibers  with 
core  diameters  up  to  150  pm  and  numerical  apertures  up  to  0.24.  The 
differential  modal  attenuation  procedure  is  curiently  set  up  for  step  index 
fibers  only. 

1.2.2.  Detector  noise  (RMS  values) 

The  following  values  for  the  average  detector  noise  were  measured  using  the 
“SUB  low_init_check”  subroutine  in  the  FOA-2000  QC  software  package. 

Thermoelectrically  cooled  Germanium  detector:  0.66  pV 
Liquid  nitrogen  cooled  Indium  Antimonide  detector:  0.7  pV 

1.2.3.  Spectral  signal-to-noise 

After  the  values  for  detector  noise  given  above  were  determined,  the  FOA- 
2000  QC  software  was  used  to  measure  the  spectral  signal-to-noise  by 
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mniiing  tiie  “SUB  Spec^snoise”  subroutine^  A  one-meter  piece  of  fiuoride 
fiber  (from  NEU  spool  nximber  891019)  was  used  to  give  a  representative  value 
for  coupling  losses  into  a  fraoride  fiber.  The  results  are  graphed  below. 


Graph  1.  Spectral  signal- to-noise  ratio 


1.2. 4  Lamp  drift 

The  FOA-2000  QC  software  subroutine  titled  “SUB  Lamp_drift”  was  used  to 
measure  tiie  drift  of  the  lamp  output  as  detected  by  both  the  germanium  (Ge) 
defector  and  tiie  indium  antimonide  (InSb)  detector.  This  test  measured  the 
detector  output  every  twenty  seconds  over  a  duration  of  60  minutes.  The  test 
indicated  that  the  germanium  detector  drilled  by  -0.002  dB  per  five  minutes. 
The  indium  antimonide  detector  v/as  measured  to  drift  by  0.004  dB  per  five 
minutes  when  the  test  v/as  performed  inunediately  after  filling  tho  inSb 
dewar  with  liquid  nitrogen.  The  same  test  was  repeated  1.5  hours  after 
filling  the  dewar,  and  the  drift  was  reduced  to  0.002  dE  per  five  minutes, 
indicating  the  need  to  prefili  the  dewar  approxitiiately  2  hours  before 
running  any  critical  tests. 
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2.0  How  the  IR  System  1  differs  from  tlie  Photon  Kinetics  FOA-  2000 

The  NRL  IR  System  1  differs  from  the  commercially  available  Photon 

Kinetics  FOA--2000  with  the  addition  or  substitution  of  several  key 

components.  They  are: 

a.  A  three-grating  monochromator,  with  a  stepper  motor  to  select  the 
grating, 

b.  custom  design  diffraction  limited  infrared  lenses, 

c.  a  quartz-tungsten  lamp  with  extended  spectral  window  envelope, 

d.  additional  cutoff  filters  for  the  extended  range  of  the  monochromator, 

e.  infrared  neutral  density  filters  to  accommodate  the  range  of  the 
monochromator, 

f.  a  liquid  nitrogen  cooled  indium  antimonide  detector  for  the  range  from 
1.8  Jim  to  4.0  Jim, 

g.  vacuum  chuck  V-grooves  to  accommodate  the  larger  fiber  diameter  of  the 
infrared  fiber, 

h.  special  annular  apertures  for  DMA  measurements, 

i.  a  numerical  aperture  measurement  technique  that  uses  a  knife  edge 
rather  than  a  pinhole  to  scan  the  far  field, 

j.  software  that  has  been  adapted  to  accoimt  for  the  differences  in  hardware. 


2.1.  Monochromator 

The  monochromator  is  a  Jarrell  Ash  Monospec®  27  with  three  gratings  that 
may  be  interchanged  by  moving  a  turret.  The  gratings  are  summarized  as 

:  £yg,_5jisp£rsifin  SEectral.b9ndEa.ss 

.6  to  1.79  Jim  6  nnJmm  3  nm 

1.8  to  2.69  Jim  12  nm/mm  6  nm 

2.7  to  4.0  Jim  24  nm/mm  12  nm 

The  approximate  spectral  bandpass  figures  assume  that  the  output  slit  size 
is  0.5  mm. 

The  monochromator  wavelength  selector  is  automated  with  a  stepper  motor. 
The  step  angle  on  the  motor  is  1.8  degree  per  step,  and  it  takes  200  steps  for 
one  complete  revolution.  The  Monospec®  27  has  an  analog  wavelength 
counter  which  is  calibrated  to  the  120O  groove/mm  grating.  lb  obtain  the 
proper  wavelength  for  each  grating,  the  counter  reading  must  be  multiplied 
by  2, 4,  and  8  for  the  600  groove/mm ,  300  groove/mm,  and  150  groove/mm 


grating  freq.  blaze  A 
600  gr/mm  1  jim 

300  gr/mm  2  jim 

150  gr/mm  4  jim 
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gratings,  respectively.  One  complete  revolution  on  the  wavelength  selector 
corresponds  to  25  nm  of  wavelength  scan  for  a  1200  groove/mm  grating.  The 
gear  ratio  between  the  monochromator  and  stepper  motor  is  3:1.  The  number 
of  steps  on  the  motor  required  to  scan  1  nm  using  the  1200  groove/mm 
grating  can  be  calculated  by  the  formula, 


where  N  is  the  number  of  motor  steps  per  revolution,  W  is  the  wavelength 
scan  per  revolution  on  selector,  and  G  is  the  gear  ratio  between  the 
monochromator  and  stepper  motor.  The  1200  groove  /  mm  grating  requires 
24  steps  for  a  1  nm  scan.  The  600  groove  /  mm,  300  groove  /  mm,  and  150 
groove  /  mm  gratings  require  12  steps  /  nm,  6  steps  /  nm  ,and  3  steps  /  nm, 
respectively. 

2.2.  Infrared  Lenses 

The  infrared  lenses  were  designed  and  constructed  by  Infrared  Optics,  Inc. 
of  Farmingdale,  NY.  They  are  multi-element  lenses  fabricated  of  barium 
fluoride  and  lithium  fluoride,  or  zinc  sulfide.  The  lenses  were  designed  to 
correct  for  most  spherical  aberrations  between  0.6  and  4.0  pm,  with  a  spot 
size  of  35  pm  at  2.5  pm  wavelength.  The  physical  dimensions  and  focal 
lengths  of  the  lenses  were  designed  to  be  identical  to  the  standard  lenses  used 
in  the  FOA-2000,  in  order  to  facilitate  their  replacements.  The  lens 
parameters  are  summarized  in  Figure  2. 

2.  3  Quartz-Tungsten  Lamp 

A  Ushio  Model  no.  JC12V-50W  H20  G/1.0  tungsten  halogen  lamp  is  used  for 
the  white  light  source.  This  lamp  utilizes  a  special  quartz  envelope  which 
has  an  extended  transmittance  out  to  4.0  pm. 

2.4  Cutoff  Filters 

Since  the  Jarrell- Ash  monochromator  has  a  greater  spectral  range  than  the 
origined  FOA--2000  monochromator,  it  was  necessary  to  add  additional  cutoff 
filters  to  eliminate  second-  and  higher-order  spectra  from  the  longer 
wavelengths.  The  filter  numbers  and  their  cut-on  wavelengths  are  listed 
below. 


Filter  Nq. 
1 
2 

3 

4 

5 


Cut-on  Wavelength 
540  nm 
850  nm 
1525  nm 
2175  nm 
3150  nm 


Page? 


2.5  Infrared  Neutral  Density  Filters 

The  neutral  density  filters  in  the  original  POA-2000  are  specified  only  for 
operation  over  the  limited  spectral  range  of  that  instrument.  They  were 
replaced  in  the  NRL IR  System  1  with  neutral  density  filters  design  for  used 
in  the  infrared  up  to  4.0  |im. 

The  attenuation  of  each  filter  was  measured  over  the  range  from  800  to 
4000  nm  using  a  modified  version  of  the  FOA-2000  QC  software  subroutine 
SUB  Attn_calib.  The  results  of  the  ND  filter  calibration  tests  are  given  in 
Appendix  A.  The  attenuation  is  not  very  uniform  over  the  spectral  range. 
The  ND  filters  are  not  used  in  any  spectral  attenuation,  differential  modal 
attenuation,  or  numerical  aperture  tests  on  the  instrument,  because  of  the 
low  radiance  of  the  lamp,  eliminating  the  need  to  attenuate  the  output  of  the 
lamp.  It  is  possible  that  the  calibration  values  given  there  could  be 
incorporated  into  a  iook-up  table  in  the  system  software,  such  that  any  time  a 
ND  filter  is  used  at  some  wavelength,  then  the  measured  attenuation  of  that 
filter  at  that  wavelength  is  recalled  for  use  in  calculations.  The  original 
FOA-2000  software  however  does  not  easily  lend  itself  to  incorporating  such  a 
feature,  so  that  including  it  would  entail  an  effort  of  moderate  difficulty. 

2.6  InSb  Detector 

A  liquid  nitrogen-cooled  indium  antimonide  (InSb)  detector  manufactured  by 
Infi’ared  Associates  is  used  to  cover  the  spectral  range  from  1800  to  4000  nm. 
The  system  software  automatically  switches  between  the  Ge  detector  and  the 
InSb  detector  at  1800  nm.  The  preamplifier  used  for  the  InSb  detector  is  an 
Infrared  Associates  model  PPA-15-IS.  The  schematic  for  the  InSb  detector 
power  supply  is  given  in  Appendix  B. 

2.7  Vacuum  Chucks  for  200  |xm  OD  fiber 

The  original  FOA-2000  vacuiim  chucks  can  only  accommodate  fibers  with 
outside  diameters  (OD)  up  to  140  jim.  These  chucks  have  been  replaced  with 
ones  that  can  accommodate  fibers  with  up  to  200  p.m  OD. 

2.8  Annular  Apertures  for  Differential  Modal  Attenuation  Measurements 

Numerical  aperture  laimch  restrictors  have  been  adapted  to  include  annular 
apertures,  which  are  used  for  launching  high  order  modes  in  step  index 
fibers,  for  differential  modal  attenuation  tests.  Launch  conditions  are 
restricted  by  manually  placing  apertures  that  restrict  the  launch  numerical 
aperture  (NA)  to  a  narrow  range,  thereby  exciting  a  limited  mode  group  in 
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the  optical  fiber.  Attenuation  values  are  derived  by  performing  a  cutback  test. 

2.9  I^nife  edge  numerical  aperture  measurements 

Due  to  the  low  radiance  of  the  lamp  source,  the  measurement  procedure  uses 
a  scanning  knife-edge,  rather  than  a  scanning  aperture  in  the  far-field  as 
specified  in  EIA  FOTP  #47.  The  knife  edge  technique  is  an  adaptation  of  an 
EIA  procedure  for  determining  the  mode  field  diameter  of  a  single  mode 
fiber.  In  this  procedure,  a  knife  edge  is  scanned  across  the  far  field  output  of 
the  fiber,  and  a  lens  is  used  to  collect  the  light  passed  by  the  knife  edge  and 
direct  it  to  the  detector.  The  computer  reads  the  output  of  the  detector  at  the 
lock-in  amplifier,  which  is  effectively  the  integrated  power  as  a  function  of  far 
field  angle.  This  data  is  then  differentiated  and  smoothed  to  yield  the  far  field 
radiation  pattern  of  the  fiber.  From  this  far  field  the  numerical  aperture  is 
derived.  A  criterion  of  5%  of  maximum  intensity  is  used  to  determine  the 
numerical  aperture. 

2.10  Major  changes  in  the  FOA-2000  software 
2.10.1  DMA  Measurement 

The  software  has  been  rewritten  so  that  multiple  wavelength  scans  can  be 
performed  in  such  a  way  that  only  one  cutback  is  required.  A  few  new 
subroutines  were  created  to  enable  this  change  in  the  measurement 
procedure.  A  description  of  their  operation  is  included  in  the  discussion 
below. 

SUB  Fibertest2:  As  with  the  Far  Field  test,  the  user  is  first  queried  as  to  the 
source  of  the  data  which  he  wishes  to  view.  That  is,  he  may  indicate  that  a 
new  test  is  to  be  performed,  or  that  data  from  a  previous  run  is  to  be  reviewed. 
Previous  data  may  either  be  data  which  was  collected  earlier  in  the  day 
(computer  on  continuously)  and  is  present  in  the  dynamic  memory  buffer,  or 
data  which  is  stored  on  a  diskette.  This  query  takes  place  by  calling  the 
subroutine  FNDatasource,  which  returns  a  0  if  a  new  test  is  desired,  1  if 
memory  in  the  buffer  is  desired,  or  2  if  the  routine  Retrieve  is  to  be  called  to 
access  data  on  diskette.  If  either  1  or  2  are  returned  to  Pibertest2,  data  is 
loaded  into  the  array  called  "Dmaattendata",  the  test  portion  of  the  routine  is 
skipped,  and  the  data  is  plotted  on  the  screen.  More  details  about  the  plot  are 
below. 

SUB  Dmarun:  First  the  user  is  queried  about  which  numerical  aperture 
restrictor  to  use  (including  #0  =  no  restrictor).  This  is  performed  by  calling 
the  routine  FNGetristrictor,  which  first  lists  the  restrictor  numbers  and  their 
corresponding  NA  range,  then  uses  the  FNGetint  to  determine  and  return 
the  (integer)  restrictor  number.  The  first  restrictor  number  is  stored  in  the 
(0,1)  position  of  the  array  "Dmarundata"  (see  supplemental  sheet  1),  while 
subsequent  numbers,  up  11,  are  stored  in  (0,2),  (0,3),  and  so  on. 
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The  wavelengths  to  scan,  and  the  total  number  of  wavelengths  to  scan,  n,  are 
shared  with  this  routine  through  the  common  block  AVavelength/  command. 
The  number  of  wavelengths  is  stored  in  the  (0,0)  position  of  "Dmarundata." 
The  (1,0)  position  of  this  array  contains  the  fiber  length,  while  the  (2,0) 
position  holds  the  number  of  DMA  runs  performed.  The  wavelength  scan  is 
then  performed  on  the  long  or  "run"  piece  of  fiber,  and  the  voltages  are  stored 
in  the  column  beneath  the  restrictor  number,  in  the  row  corresponding  to  the 
wavelength  at  which  the  voltage  was  read. 

After  each  before-the-cutback  scan,  the  user  is  asked  to  see  if  another  DMA 
run  (i.e.,  another  NA  range)  is  desired;  if  yes,  the  new  restrictor  number  is 
requested,  time  given  *^3  insert  the  restrictor,  and  the  program  returns  to  the 
wavelength  scan  portion  and  continues  as  before. 

If  no  more  NA  ranges  are  desired,  the  user  is  directed  to  cutback  the  fiber, 
being  careful  to  leave  the  input  end  undisturbed.  The  routine  Outalign  is 
then  called  to  align  tlie  output  end.  The  first  restrictor  used  before  cutback  is 
requested,  and  a  short  or  "ref  fiber  wavelength  scan  is  performed.  The 
voltage  data  here  is  now  stored  in  columnar  form  in  an  array  called 
"Dmarefdata,"  which  has  the  same  (0,0),  (1,0),  (2,0)  entries  as 
"Dmarundata." 


It  should  be  xmderstood  that  before  the  first  wavelength  scan  on  the  long 
fiber,  the  signal  on  the  detector  (through  the  fiber)  is  read  using  the  LED 
source.  This  is  taken  as  an  alignment  reference.  After  the  scan  for  each 
DMA  run,  the  alignment  is  again  checked,  and  if  it  has  varied  by  more  than 
1%,  the  user  is  informed  and  given  the  choice  of  re-doing  that  particular 
scan,  exiting  the  test,  or  proceeding.  The  same  type  procedure  is  used  to 
insure  integrity  of  the  input  fiber  end  alignment  after  the  cutback  is 
performed. 


SUB  Dmacomp:  The  data  from  the  two  arrays  are  passed  through  a  COM 
statement  to  this  routine,  where  the  calculation  is  performed  to  determine 
the  spectral  attenuation  for  each  NA  range  (represented  by  respective 
restrictor  number).  This  outcome  of  the  computation  is  stored  in  an  array 
named  "Dmaattendata,"  while  the  wavelengths  used  for  the  scan  are  stored 
in  the  positions  (1,0)  -  (n,0) ,  i.e.,  the  first  column  of  this  array.  As  explained 
in  the  supplemental  sheet  2,  the  (0,0)  position  of  this  array  contains  both  the 
number  of  wavelength  scans  n,  and  the  number  of  DMA  runs  performed,  m. 


SUB  Dmanlotprep:  Next  the  user  is  queried  as  to  which  column  of  data  he 
wishes  to  view  (i.e.,  which  restrictor).  His  choice  column  is  loaded  into  he 
second  column  of  the  array  Specattdata,  while  the  wavelengths  are  loaded 
into  the  first  column.  The  fiber  ID  number,  including  the  restrictor  number 
and  fiber  length  are  loaded  into  the  string  Speeattjd$.  Then  the  routine 
Specatplot  is  called  to  plot  the  particular  column  of  data  requested,  and 
operates  in  the  same  way  as  an  ordinary  spectral  attenuation  plot  as 
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described  by  Photon  Kinetics  in  their  software  listing  remarks.  If  at  any 
point  the  "STORE  DATA"  option  is  entered,  the  program  exits  the  plot,  enters 
the  Archive  subroutine,  and  stores  the  contents  of  the  array  "Dmaattendata," 
and  then  returns  the  user  to  the  main  menu.  To  further  review  data,  such 
as  the  loss  results  of  other  restrictors,  the  "Recall  data"  option  must  be 
chosen  from  the  DMA  menu. 

2.10.2  Far  Field  Mv^asurement 

This  test  was  changed  to  run  from  its  own  menu,  and  allow  the  user  the 
option  to  smooth  the  data  by  averaging  a  variable  number  of  points.  The 
attached  flow  chart  may  aid  in  imderstanding  the  logic. 

Presuming  a  new  test  is  specified,  the  kxiife  edge  will  scan  across  the 
collimated  far  field  pattern,  moving  to  gradually  cut  off  the  power  reaching 
the  detector.  A  normalized  version  of  the  data  from  this  scan  is  held  in  an 
array  called  "Farfield;"  it  is  considered  the  "raw"  data,  and  is  plotted  against 
scanner  position.  This  data  can  be  differentiated  to  obtain  an  actual  far  field 
output  pattern,  or  can  be  smoothed  directly.  When  the  Differentiate  option  is 
chosen,  the  raw  data  is  first  loaded  into  an  array  called  "Ffrawdata."  Then  it 
is  differentiated,  corrected  to  account  for  a  small  angle  approximation, 
renormalized,  and  stored  in  an  array  "Ffdiffdata,"  which  is  again  plotted  on 
screen.  In  addition,  the  routine  Numaper  is  called  to  calculate  the 
numerical  aperture,  which  is  displayed  below  the  plot.  At  this  point  the  user 
may  smooth  the  differentiated  data,  or  return  to  the  raw  data  plot.  If  the 
Smooth  Data  option  is  chosen,  he  is  asked  for  the  number  of  points  to 
average,  the  data  smoothing  routine  Ffsmooth  is  called,  and  the  smoothed, 
normalized  version  of  the  data  is  stored  in  an  array  called  "Ffsmoothdata." 
This  is  plotted  on  the  display,  along  with  a  recalculated  value  of  numerical 
aperture.  Further  smoothing  may  then  be  performed  on  the  raw, 
differentiated,  or  smoothed  data,  and  plotted  accordingly. 

It  may  be  noted  that  when  the  raw  data  is  smoothed,  at  present  the  smoothed 
version  may  not  be  differentiated,  only  viewed.  Because  the  "smoothed"  raw 
data  actually  appeared  to  be  less  smooth  than  the  actual  raw  data,  and 
because  of  ambiguities  introduced  into  the  numerical  aperture  calculation 
due  to  smoothing,  this  was  not  further  modified,  though  is  would  be 
relatively  straightforward  to  do  so.  Furthermore,  an  alternate  routine  has 
been  sketched  out  (included)  by  George  McCabe  which  would  fit  the  data  to  a 
Gaussian  distribution  and  look  for  the  5%  points  there.  In  the  end,  this 
might  offer  a  more  repeatable  method  to  obtain  a  value  for  the  numerical 
aperture. 

2.10.3  Program  Organization 

Lines  relevant  to  unused  tests  were  purged  in  many,  but  not  all,  places  in  the 
system  software.  Large  blocks  such  as  the  FibertestX  subroutines  and 
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associated  routines  were  deleted,  but  remnants  exist  in  other  places  due  to 
not  wanting  to  alter  the  "foasetup"  file  and  the  way  it  is  stored.  All  lines 
relevant  to  the  Near  Field  test  were  retained. 

2.10.4  Fiber  Alignment 

The  Inalign  and  Outalign  routines  have  been  altered  so  that  the  first  time 
either  are  called,  the  alignment  is  performed,  and  a  counter  variable  is  set 
equal  to  1.  At  the  end  of  the  alignment,  the  final  voltage  on  the  Ge  detector  is 
read  and  held  in  the  first  position  of  a  variable  array,  called  Sig(l).  The 
routine  then  returns  and  aligns  the  fiber  a  second  time,  and  holds  the  new 
final  voltage  in  Sig(2).  These  two  voltage  values  are  then  compared,  and  if 
they  differ  by  more  than  1%,  the  user  is’told  so,  and  given  the  option  of 
continuing  anyway,  or  returning  to  re-align.  If  the  latter  is  chosen,  then 
eventually  Sig(3)  and  Sig(2)  are  compared  as  before  and  so  on.  At  present,  the 
maximum  number  of  alignments  that  can  be  performed  in  this  way  is  10. 
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3.0.  Normal  Operating  Procedures 

This  section  describes  the  daily  procedures  required  for  proper  normal 
operation  of  the  system. 

3.1.  Turn-on  procedure 

The  proper  sequence  for  bringing  the  system  up  is  outlined  below. 


a.  Turn  on  the  FOA-2000  control  panel  by  turning  the  key  on  the  front  panel. 

b.  Turn  on  the  EG&G  5207  lock-in  amplifier. 

c.  Turn  on  the  red  (illuminated)  switch  on  the  power  supply. 

d.  Check  the  voltage  of  the  preamp  batteries  in  the  power  supply  chassis.  Td 
do  this,  switch  the  small  toggle  switch  labeled  "Meter"  to  either  1  or  2. 
There  are  two  sets  ofbatteries,  labeled  land  2,  respectively.  One  set  is 
normally  connected  to  the  preamp  while  the  other  is  held  in  reserve,  or  is 
being  recharged.  The  voltage  of  the  set  in  use  should  read  greater  than  11 
volts.  Switch  the  batteries  on  by  turning  the  switch  labeled  "Preamp 
Batteries"  to  the  set  with  the  higher  voltage.  If  the  other  set  shows  a 
voltage  below  11  volts,  connect  iiie  two  battery  chargers  to  the  connectors 
labeled  "CHARGERS"  on  the  back  of  the  power  supply  unit.  The  reserve 
batteries  will  be  charged  automatically. 

Important:  Switch  the  "Meter"  switch  to  "off*  after  checking  the 
batteries.  If  it  is  left  on ,  the  discharge  of  the  batteries  will  be  accelerated. 

e.  Make  sure  that  the  InSb  detector  dewar  is  filled  with  liquid  nitrogen. 
When  refilling  the  dewar,  it  is  not  necessary  to  shield  the  detector  from 
room  light.  The  lens  that  covers  the  detector  face  does  not  transmit  light 
of  a  wavelength  below  1.0  pm.  For  minimal  drift,  the  dewar  should  be 
filled  two  hours  before  any  important  measurements. 

f.  Load  and  run  the  system  software,  as  describe  below. 

3.2.  Software  set-up 

Place  the  disk  labeled  "DISK  #1  (AUTOBOOT)"  in  the  left  hand  drive  (drive  0) 
of  the  computer.  TVirn  the  monitor,  disk  drive,  printer,  and  computer  on. 
When  the  computer  prompts,  remove  the  autoboot  disk  and  replace  it  in 
drive  0  with  the  system  software  disk.  The  system  software  will  execute 
automatically,  and  present  the  user  with  a  menu. 


3.3.  Fiber  End  Preparation 

For  proper  use  of  the  vacuum  fiber  chucks  and  the  elastomeric  fiber  clamps, 
it  is  necessary  to  strip  at  least  two  inches  of  jacket  from  the  fiber  end.  The 
best  location  for  positioning  the  clamp  on  the  fiber  can  be  gauged  by  using  the 
two  short  strips  of  black  tape  on  the  fiber  shelf.  The  distance  from  the  tape  to 
the  edge  of  the  fiber  shelf  is  the  proper  length  of  bare  fiber  that  should  extend 
from  the  fiber  clamp. 


3.4  Important  Commands 


Here  we  hst  several  convenient  commands  that  may  be  executed  from  the  HP 
computer. 


Command 

Stop 

Call  Menu 
Call  Nextwave 


Call  Fibertestl 

Call  Fibertest2 
Call  Fibertest3 
Call  Clearup 
Run 


Effect 

To  stop  execution  of  the  system  software  because 
something  is  wrong. 

To  access  the  main  menu. 

To  have  the  unit  set  to  a  particular  wavelength.  For 
example,  to  set  the  wavelength  to  850  nm,  execute 
“CALL  WAVELENGTH(850)”.  See  the  note 
“IMPORTANT’  below. 

To  run  the  spectral  attenuation  test  directly  from  the 
keyboard  without  having  to  access  it  from  the  main 
menu. 

To  run  the  differential  modal  attenuation  test  directly 
from  the  keyboard. 

To  run  the  numerical  aperture  test  directly  from  the 
keyboard. 

Clears  the  GPEB  bus  and  resets  the  phase  on  the  lock-in 
amplifier. 

To  reinitialize  the  FOA-2000  control  panel.  This  must  be 
done  each  and  every  time  the  control  panel  is  turned  off 
emd  on  again.  If  the  FOA-2000  control  panel  is  turned 
on,  then  the  system  software  must  be  restarted 
in  order  to  reinitialize  the  7,-80  uprocessvsr  in  the 
FOA-2000  control  panel.  In  order  to  do  tliis,  stop  the 
program  execution  (it  may  be  necessary  to  hit  the  break 
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key),  and  then  type  “RUN”  and  press  the  return  key.  It  is 
not  sufficient  to  “CALL  MENU.”  The  system  software 
must  be  restarted.  After  restarting  the  software,  the 
“Equipment  Preset”  routine  should  be  run. 


Call  F2000send  (“INSB”) 

Connects  the  InSb  detector  to  the  lock-in  amplifier,  and 
sets  the  mirrors  to  direct  the  fiber  output  to  the  InSb 
detector. 

Call  Cleardata  To  clear  all  data  fi*om  the  memory  buffer.  This  should  be 

called  befrore  running  the  first  test  on  a  new  fiber  if 
other  fibers  were  nm  since  the  machine  was  turned  on. 


IMPORTAN’K  To  set  the  monochromator  to  a  desired  wavelength,  it  is 
necessary  to  use  the  “CALL  NEXTWAVE”  command  instead  of  using  the 
front  panel  control.  The  system  software  will  then  insure  that  the  correct 
grating,  cutoff  filter,  and  detector  are  set  up.  In  addition,  the  software 
calculates  the  proper  setting  for  the  monochromator  shaft  and  automatically 
sets  it  there.  The  control  panel  should  only  be  used  to  make  minor  (<50  nm) 
adjustments  in  the  wavelength  displayed  on  the  control  panel  LED  display. 
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4.0.  Maintenance 


4.1  Alignment  Procedure  for  NKL  IK  System  1 

4.1.1  Definitions; 

The  X  direction  is  perpendicular  to  the  beam  direction,  and  parallel  to  the 
bench  surface.  The  y  direction  is  perpendicular  to  botii  the  beam  direction 
and  the  bench  surface.  The  z  direction  is  parallel  to  the  beam  direction. 

The  IK  target  is  an  aluminum  piece  with  cross-hair  lines  etched  on  it.  Its 
base  should  just  fit  into  the  milled  slots  (to  assure  lateral  consistency),  and 
have  a  cross-hair  marked  directly  over  the  center  of  the  slot  at  a  height  of  1 
5/8  inches  above  the  surface  of  the  bench  (not  the  slot). 

4.1.2.  Main  LED  Beam  Path. 

a.  Remove  lenses  1,  2,  3,  4  from  the  bench.  Select  LED  on  the  front  panel,  with 
the  launch  spot  out.  Using  the  IK  target,  align  the  LED  beam  all  the  way 
around  the  bench  to  the  camera.  Start  by  engaging  LASER  1  on  the  front 
panel.  When  this  is  done,  the  mirror  in  BS2  will  switch  out  to  allow  the  beam 
to  pass  through  BS2,  In  addition,  the  stepper  motor  driving  the 
monochromator  turret  will  attempt  to  turn  the  shaft.  This  is  expected,  so 
don't  be  concerned  by  the  sound.  Put  the  lit  target  in  the  milled  slot  at 
position  A,  and  adjust  the  LED  lens  7  in  x  and  y  to  align  the  LED  output  to  the 
cross-hairs.  Adjust  the  lens  in  z  in  order  to  collimate  the  beam  as  well  as 
possible. 

b.  Next  disengage  LASER  1  to  bring  the  lower  mirror  in  BS2  back  up,  directing 
the  beam  towards  BS4.  Again  align  the  beam  to  the  IR  target.  Now  engage 
THRU  TRANSMISSION  with  the  output  target  out,  and  adjust  BS4  lower 
mirror  to  direct  the  beam  onto  the  IR  target  at  C.  Engage  FIBER  OR 
SOURCE  and  proceed  to  align  to  the  IR  target  at  D.  It  may  be  necessary  to  re¬ 
adjust  the  collimation  by  tweaking  the  z  position  of  the  LED  lens  7.  Next 
adjust  mirror  Ml  to  collect  as  much  of  the  beam  as  possible,  and  direct  it 
towards  the  target  at  position  F.  The  275  mm  lens  11  should  still  be  in  place, 
roughly  half  way  between  Ml  and  M2.  Finally,  adjust  M2  to  direct  the  beam 
into  the  video  camera.  Leave  the  image  of  the  LED  on  the  right  one  third  of 
the  monitor,  centered  vertically. 

4.1.3.  Input  Objective  Lens. 


a.  Cent^sr  the  input  objective  lens  5  in  x,  y,  and  z  over  the  range  of  travel  of  the 
respecti/e  motors.  To  Ob  this,  first  push  the  appropriate  button  on  the  front 
pan  il  to  engage  the  corresponding  motor.  Then  turn  the  front  panel  knob 
until  the  front  panel  display  shows  four  dots,  indicating  that  the  motor  ha.s 
ieachedtne  end  of  its  range  of  travel.  Then  press  the  ZERO  button  to  zero  the 
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display.  Next,  while  holding  the  local  button  down,  rotate  the  front  panel 
knob  in  the  opposite  direction  (from  the  previous  motion)  tmtil  the  four  dots 
vanish.  Release  the  local  button  and  continue  tiuming  the  knob  imtil  the  four 
dots  appear  again,  indicating  the  limit  of  travel  in  the  opposite  direction. 

Take  the  reading  on  the  front  psuiel  display  and  divide  by  two  (if  the  display 
“tripped  over”  to  000,  be  sure  to  add  1000  to  the  number  before  division).  Hold 
the  local  button  down,  and  rotate  the  the  knob  in  the  opposite  direction  imtil 
the  dots  vanish.  Then  move  the  knob  until  the  display  shows  the  number  that 
resulted  from  the  division  by  two.  Press  ZERO  to  re-zero  the  display.  This 
position  is  the  center  of  travel  in  the  appropriate  axis.  Repeat  tliis  procedure 
for  the  remaining  two  axes. 

b.  Place  the  lens  cap  (with  white  target  and  mark  in  center)  on  the  lens. 

Position  the  lens  in  x,  y,  and  z  so  that  the  center  of  the  LED  beam  strikes  the 
center  of  the  lens  cap.  Note  the  reading  on  the  front  panel  in  x  and  y,  which 
displays  how  many  units  away  from  the  center  of  the  lens  travel  the  LED 
beam  is. 

c.  If  the  reading  in  x  or  y  is  more  than  about  150  units,  the  brass  U-shaped 
bracket  in  the  opto-sensor  may  need  to  be  adjusted  to  redefine  the  lens  travel 
limits  and  therefore  the  lens  travel  zero.  In  order  to  do  this,  remove  the 
bracket  holder  (x  axis  is  imderneath  bench,  y  is  above),  and  adjust  the 
position  either  up  or  down  slightly.  Repeat  steps  a  and  b  until  the  LED  beam 
corresponds  to  the  center  of  the  x  and  y  lens  travel  to  within  acceptable  limits. 

d.  Redefine  the  zero  lens  position  at  the  center  of  the  LED  beam  by  pressing  the 
ZERO  button  on  the  front  control  panel  for  each  input  lens  motor. 

4.1.4.  Input  Fiber  Chuck. 

a.  Remove  the  lens  cap  from  lens  5.  Make  sure  step  2d  has  been  taken. 

b.  Prepare  a  length  of  fiber  (1-2  meters)  with  cleaved  ends.  Place  one  end  in  the 
input  fiber  chuck,  and  place  the  other  end  of  the  fiber  in  a  power  meter  (Si 
detector). 

c .  Loosen  the  set  screws  holding  the  vacuum  chuck  and  adjust  the  vacuum 
chuck  to  maximize  the  power  injected  through  the  fiber,  as  detected  by  the 
power  meter.  To  adjust  horizontally,  move  the  vacuum  chuck  horizontally. 
Make  an  effort  to  keep  the  chuck  axis  perpendicular  to  the  lens.  To  adjust 
vertically,  use  the  front  panel  control  (input-y).  To  adjust  longitudinally, 
push  the  fiber  in  and  out  for  coarse  adjustments,  and  use  the  front  panel 
(input-z)  fo’*  fine  adjustments. 

d.  Tighten  chuck  screws  so  that  the  chuck  is  locked  firmly  in  place. 
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4.1.5.  Laimch  Spot. 

a.  Engage  the  BS4  lower  mirror  by  pressing  SOURCE.  Replace  lens  2  on  the 
bench.  Set  launch  spot  into  the  beam  by  engaging  LA'^^INCH  SPOT.  Move 
lens  2  along  the  slot  (in  z)  to  focus  the  spot  on  the  momtor. 

b.  Disengage  the  launch  spot.  Replace  lens  1  (in  the  adjustable  mount)  on  the 
bench  and  move  it  along  the  slot  to  focus  the  LED  on  the  monitor.  Adjust  the 
lens  mount  in  x  and  y  to  center  the  LED  image  over  its  previous  position  on 
the  right  one  third  of  the  monitor,  centered  vertically. 

c.  Engage  the  launch  spot  again.  Adjust  the  aperture  position  on  the  launch 
spot  carriage  in  x  and  y  to  center  the  spot  over  the  center  of  the  LED  image. 

4.1.6.  Output  Objective  Lens. 

a.  Engage  the  beamsplitter  mirror  in  the  top  of  BS4  by  pressing  FIBER  LOAD. 
Loosen  the  mirror  and  adjust  it  until  a  (probably  dim)  reflected  image  of  the 
input  fiber  end  is  positioned  over  the  LED  image  (right  one  third,  centered 
vertically).  This  squares  the  position  of  the  light  reflected  onto  the  output 
objective  lens. 

b.  Follow  the  procedure  of  Step  2  to  center  the  output  objective  lens  within  its 
range  of  travel.  Note  however  that  because  of  the  nature  of  the  beamsplitter, 
in  this  case  the  LED  beam  will  appear  as  a  half-circle  only.  Be  sure  to 
redefine  the  zero  lens  position  for  each  output  lens  motor. 

c .  Re-adjust  the  upper  beamsplitter  mirror  of  BS4  to  direct  the  input  fiber  image 
onto  the  left  third  of  the  monitor,  centered  vertically  (over  the  grease  pencil 
marks).  Tighten  the  mirror  screws  to  lock  it  into  place. 

4.1.7.  Output  Fiber  Chuck. 

a.  Place  one  end  of  the  prepared  fiber  in  the  output  chuck.  Inject  white  light 
into  the  other  end  (this  may  be  simply  accomplished  by  placing  the  fiber  end 
near  the  filament  of  an  ordinary  light  bulb). 

b.  Press  THRU  TRANSMISSION  to  allow  the  white  light  through  the  fiber  to 
reach  the  camera.  Loosen  the  set  screws  holding  the  output  vacuum  chuck 
^d  adjust  the  chuck  horizontally  to  put  the  output  fiber  image  over  the  LED 
image  in  the  right  one  third  of  the  Bcreen.-  Center  the  image  vertically  by 
adjusting  the  front  panel  control  (output-y).  To  focus  the  image,  push  the 
fiber  in  and  out  for  coarse  adjustments,  and  use  the  front  par  el  (output-z)  for 
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fine  adjustments. 


c .  Place  the  IR  target  at  the  position  of  lens  3  and  check  that  fiber  output  is 
aligned  with  crosshairs.  Then  place  IR  target  just  after  lens  11  and  insure 
that  beam  is  still  aligned  with  crosshairs.  If  not,  move  the  output  fiber  chuck 
angularly  in  x,  and  tiien  reiterate  steps  b  and  c  imtil  the  output  fiber  path  lies 
squarely  over  the  line  between  BS4  and  BS5. 


4.1.8.  Output  Target. 

a.  Replace  lens  4  on  the  bench.  Engage  the  output  target.  Move  lens  4  along  the 
.  slot  (in  z)  to  focus  the  image  of  the  output  target  on  the  monitor. 

b.  Disengage  the  output  target.  Replace  lens  3  (in  the  adjustable  mount)  on  the 
bench  and  move  it  along  the  slot  to  focus  the  LED  on  the  monitor.  Adjust  the 
lens  mount  in  x  and  y  to  center  the  LED  image  over  its  previous  position  on 
the  right  one  third  of  the  monitor,  centered  vertically. 

c .  Engage  the  output  target  again.  Position  the  aperture  on  the  output  target 
carriage  in  x  and  y  over  the  LED  image. 

d.  At  this  point  the  LED,  output  fiber,  and  output  target  should  all  be  focussed 
on  the  same  position  on  the  right  one-third  of  the  screen,  centered  vertically. 
This  position  should  be  remarked  with  a  grease  pencil  if  necessary. 


4.1.9.  Lamp  Path. 

a.  Engage  LED  on  the  front  panel.  Switch  the  lamp  on,  if  it’s  not  on  already. 

Put  the  IR  target  at  position  F  in  the  milled  slot  that  leads  from  the 
monochromator  output  and  BS3.  Adjust  lens  8  to  focus  the  monochromator 
output  on  the  IR  target.  Also  adjust  the  positioning  knob  on  top  of  the  lamp  to 
maximize  the  amount  of  light  into  the  monochromator,  and  onto  the  IR 
target. 

b.  Engage  the  LAMP  on  the  front  panel.  Engage  the  button  below  “LASER 
THREE”  on  the  front  panel.  As  before,  BS2  will  switch  mirrors  and  the 
stepper  motor  driving  the  monochromator  turret  will  attempt  to  turn  the 
shaft.  Put  the  IR  target  in  the  milled  slot  at  position  A.  A<^ust  the  mirror  in 
BS3  to  align  the  monochromator  output  to  the  crosshairs  as  well  as  possible. 
Engage  LED  again. 

4.1.10.  Ge  Detector. 

a.  Engage  SOURCE,  Ge  DET,  and  DETECTOR  on  the  front  panel  control.  With 
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the  attenuator  at  0,  an  image  of  the  LED  reflected  from  the  surface  of  the  Ge 
detector  should  be  visible  on  the  monitor.  Adjust  lens  10  (on  the  detector 
module)  in  x,  y,  and  z  to  roughly  center  and  focus  the  image  within  the  large 
area  of  the  detector. 

b.  Disengage  the  DETECTOR  switch  (upper  beamsplitter  mirror  on  BS5),  and 
maximize  the  output  of  the  Ge  detector  as  seen  on  the  lock-in  amplifier. 

c.  Re-engage  DETECTOR  and  be  sure  the  image  of  the  LED  is  not  too  near  the 
edge  of  the  Ge  detector.  (The  most  sensitive  spot  on  the  detector  appears  to  be 
near  the  upper  left  edge.)  Finally,  disengage  the  DETECTOR  switch. 

4.1.11. InSb  Detector. 

a.  In  order  to  engage  the  InSb  detector,  the  FOA-2000  System  Software  must 
have  been  loaded  onto  the  HP  computer.  If  the  program  is  running  (e.g.  a 
menu  is  displayed  on  the  HP  screen),  first  press  STOP  on  the  keyboard.  To 
connect  the  detector  output  to  the  lock-in  amplifier,  type  the  command 

CALL  F2000send(’TNSB") 

b.  Adjust  lens  9  on  the  InSb  detector  module  in  x,  y,  and  z  to  maximize  the 
output  of  the  detector  as  seen  on  the  lock-in  displa}^  Large  adjustments  in  x 
and  y  are  not  recommended. 
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5.0.  How  to  get  help. 


In  the  event  that  the  system  does  not  appear  to  operate  correctly,  or  if  the  HP 
computer  returns  an  error  message,  the  appropriate  sequence  of  actions  is 
as  follows: 

1.  Review  the  section  below  entitled  "Likely  Problems"  to  see  if  the  fix  is 
indicated  there. 

2.  If  the'computer  indicates  an  FOA-2000  error  message,  check  page  12-16 
of  the  Photon  Kinetics  Installation  manual  for  an  explanation  of  the 
problem. 

3.  If  the  computer  indicates  an  HP  software  problem,  then  check  the 
"Error  Message"  appendix  of  the  HP  Language  Reference  manual  for 
an  explanation  of  the  error. 


If  the  above  steps  do  not  remedy  the  situation,  then  contact  Russ  May  or  Rick 
Claus  at  the  Fiber  &  Electro-Optics  Research  Center,  "Virginia  Tech,  at 
(703)  231-7203.  Replacement  parts  and  knowledgeable  insight  into  the  correct 
operation  of  the  original,  vmaltered  FOA-2000  may  be  obtained  by  calling 
Customer  Support  at  Photon  Kinetics,  Beaverton,  OR,  at  (503)  644-1960.  It 
should  be  made  clear  to  Photon  Kinetics  that  the  instrument  under 
discussion  is  Serial  No.  E4221,  which  was  adapted  for  use  with  fluoride  fiber 
by  \^rginia  Tech. 

5.1  FOA-2000  Error  Messages: 

Occasionally  the  HP  computer  will  indicate  an  "FOA-2000  error"  together 
with  an  error  number.  Most  often  this  may  occur  when  the  computer  will 
mistakenly  try  to  drive  a  stepper  motor  beyond  its  permissible  range.  The 
meaning  of  the  error  number  may  be  found  on  page  12-16  of  the  FOA-2000 
Installation  manual. 

Some  of  the  system  software  routines  poll  the  instrument  status  of  the  EG&G 
lock-in  amplifier.  If  an  error  is  returned  by  the  lock-in  to  the  HP  computer, 
the  routine  will  indicate  an  error  and  report  the  HP  basic  error  number.  A 
description  of  the  error  and  the  associated  number  is  found  in  the  “Error 
Message”  appendix  in  the  back  of  the  HP  Basic  Language  Reference 
manual. 


5.2  Likely  Problems 


A  list  of  likely  problems,  their  possible  causes,  and  remedies  follow: 


Problem 


EQSsible.JGaiisg.^n^Rgm£dy 


Computer  displays 
“Division  by  zero”  eiTor; 
or  output  graphs  show 
measurements  to  be 
very  noisy. 


a.  Preamp  power  supply  not  turned  on. 

b.  Lamp  power  supply  not  switched  on. 

c.  Lamp  bulb  burned  out. 

d.  Preamp  battery  charge  low. 

e.  The  phase  lock  may  have  been  lost  on  the 
phase-lock  amplifier.  This  appears  to 
happen  after  the  GPIB  bus  has  been  cleared 
vuth  a  “CLEAR  7”  command.  To  reset  the 
phase  of  the  amplifier,  type  “CALL 
CLEARUP”  and  Return.  If  the  program 
has  been  halted,  then  type  “CALL  MENU”  to 
access  the  main  menu. 

f.  Tried  to  read  archived  data  in  from  a 
non-existent  file. 


FOA  Error  no.  97  If  the  FOA-2000  control  panel  is  turned  on, 

then  the  system  software  must  be  restarted 
in  order  to  reinitialize  the  Z-80  ^processor 
in  the  FOA-2000  control  panel.  In  order  to 
do  this,  stop  the  program  execution  (it  may 
be  necessary  to  hit  the  break  key),  and  then 
type  “RUN”  and  press  the  return  key.  It  is 
not  sufficient  to  “CALL  MENU.”  The 
system  software  must  be  restarted.  After 
restarting  the  software,  the  “Equipment 
Preset”  routine  should  be  run. 


The  HP  computer  seems 
to  have  halted  or  is  “stuck” 
while  trying  to  issue  a 
command  to  the  FOA-2000 
unit  or  the  lock-  in 
amplifier. 

press  the  return  key.  Then  type  “ 
return  key.  This  will 
the  lock-in 
when  a 

It  may  be  possible 
by  typing 
it  will  be 
and  restart  the 


The  GPIB  bus  may  have  crashed  when 
program  execution  was  halted  while 
the  computer  was  issuing  a  command 
or  waiting  for  a  status  b3de  on  the  bus. 

To  remedy,  first  press  the  “STOP”  key 
on  the  computer.  Then  type  “CLEAR  7”  and 
CALL  CLEARUP”  and  the 

cause  the  phase  to  be  reset  on 
amplifier,  which  is  often  lost 
“CLEAR  7”  is  executed, 
to  continue  program  execution 

1,  .1  Til.*!,, 

,  uut  mux'u 

necessary  to  “CALL  MENU” 
test  from  the  beginning. 
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Can’t  see  the  fiber  end  a.  Bad  fiber  end.  Recleave. 

in  “FIBER  LOAD”  mode.  b.  Fiber  end  off  the  screen.  Put  the  FOA- 

2000  in  “VIDEO  OUT”  mode,  and  peak  the 
reading  on  the  lock-in  amp  as  the  fiber  is 
manually  adjusted  using  the  fiber 
movement  controls  on  the  FOA-2000  control 
panel.  Then  return  the  FOA-2000  to  “FIBER 
OR  SOURCE”  mode. 


During  auto-alignment, 
the  computer  consistently 
returns  messages  indicating 
that  the  fiber  end  positions 
need  to  be  adjusted. 


a.  The  fiber  end  might  not  be  perpendicular 
to  the  fiber  axis.  Check  the  end  angle  using 
a  fiber  inspection  scope,  or  recleave  the 
fiber. 

b.  The  fiber  alignment  motors  may  need  to 
be  recentered.  See  page  13-1  of  the  FOA- 
20C0  installation  manual  for  a  procedure  to 
rece-'ter  the  motors. 


Grinding  sound  from  In  this  case,  the  computer  has  lost  track  of 

monochromator  actual  position  of  the  monochromator  shaft, 

and  is  attempting  to  drive  the  shaft  past  its 
limits.  The  grinding  sound  results  from 
the  stepper  motor  slipping.  To  remedy,  turn 
off  the  key  switch  on  the  FOA-2000  control 
panel  immediately.  Then  turn  on  the  front 
panel  again,  and  type  and  execute  “RUN” 
on  the  HP  computer.  Then  run  the 
“EQUIPMENT  PRESET”  subroutine  from 
the  main  menu. 
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Appendix  A.  Neutral  Density  Filter  Calii 


.on  Results 


Page  24 


SPECTRAL  ATTENUATION 

FIBER  ID:  Attenuator  calibration  for  ATTN  #1  17-MAR-90  14:26:41 
LENGTH:  0  kn 

WAUELENGTH  ATTENUATION  ( dB  ) 


•  800 

-11.56 

850 

-11.14 

900 

-9.83 

950 

-6.91 

1000 

-4.89 

1050 

-3.55 

1100 

-2.69 

1150 

"2.11 

1200 

-1  .76 

1250 

-1.65 

1300 

-1  .45 

1350 

-1.49 

1400 

-2.07 

1450 

-1  .87 

1500 

-1.96 

1550 

-7.06 

1600 

-7.41 

1650 

"8.43 

1700 

-8.39 

1750 

-8.21 

1800 

-9.21 

1850 

-8.17 

1900 

-8.1  1 

1950 

-8.03 

2000 

-7.98 

2050 

-7.92 

2100 

-7.87 

2150 

-7.82 

2200 

-7.75 

2250 

-7.71 

2300 

-7.66 

2350 

-7.60 

2400 

2450 

-7.48 

2500 

-7.42 

2550 

-7‘.34 

2600 

-7.32 

2650 

-7.24 

2700 

-7.23 

2750 

-7.12 

2800 

-7'.  1  1 

2850 

-7. 1  1 

2900 

-7.11 

2950 

"7.09 

3000 

-7.07 

j  i  bV 

-b .  y  f 

3200 

-6.93 

3250 

-6.8p 

3300 

-B.85 

3350 

-6.82 

3400 

-6.8! 

3450 

-6.77 

350:3 

-6.76 

35u0 

-6.73 

3600 

-6.70 

3850 

-6.66 

3700 

-6.83 

3750 

-6.60 

3800 

-6.59 

3850 

-6.55 

3900 

-6.55 

3950 

-B.52 

4000 

-6.49 

SPECTRAL  ATTENUATION 

FIBER  id:  Attenuator  calibration  for  ATTN  *2  17-NAR-90  14s34;S9 
LENGTH;  0  kn 

WAVELENGTH  ATTENUATION  (dB) 


800 

-22.56 

850 

-21.82 

900 

“20.25 

950 

-16.98 

1000 

-14.60 

1050 

-12.92 

1 100 

-1 1 .73 

1150 

-10.88 

1200 

-10.30 

1250 

-9.98 

1300 

-9.59 

1350 

-9.50 

1400 

-9.98 

1450 

-9.82 

1500 

-9.62 

1SS0 

-14.47 

1600 

-14,80 

1650 

-15.71 

1700 

-15.60 

1750 

-15.44 

1800 

-15.37 

1850 

-15.28 

1900 

-15.20 

1950 

-15.10 

2000 

-15.04 

2050 

-14.99 

2100 

-14.94 

2150 

-14.89 

2200 

-14.04 

2250 

-14.81 

2300 

-14.78 

2350 

-14.77 

2400 

-14.66 

2450 

-14.65 

2500 

-M.64 

2550 

-14.55 

I 

I 

I 

I 


i 

f 

I 

f 


n 


<-  ^  vy 

•M4.a4 

2750 

-14.52 

2800 

-14.49 

2850 

-14.45 

2900 

-14.45 

2950 

-14.48 

3000 

-14.48 

3050 

-U.S1 

3100 

-14.49 

3150 

-14.43 

3200 

-14.38 

3250 

-14.32 

3300 

-14.28 

3350 

-14.26 

3400 

-14.25 

3450 

-14.25 

3500 

-14.22 

3550 

-14.21 

3600 

-14.22 

■3650 

-14.23 

3700 

-14.22 

3750 

-14.20 

3800 

-14.18 

3850 

-14.17 

3900 

-14.16 

3950 

-14.18 

4000 

-14.18 

SPECTRAL  ATTENUATION 


FIBER  ID:  Attenuator  calibration  for  ATTN  t3  )7-MAR-90  14:44:37 
LENGTH:  0  kn 

WAVELENGTH  ATTENUATION  < dB  ) 


800 

-34.31 

850 

-33.71 

900 

-32,25 

950 

-29. 15 

1000 

-26.99 

1050 

-25.42 

1100 

-24.28 

1150 

-23.45 

1200 

-22.87 

1250 

-22.54 

1300 

-22.15 

1350 

-22.02 

1400 

-22.42 

1450 

-22.06 

1500 

-22.00 

1550 

-26.65 

1600  ■ 

-26.85 

1650 

-27.68 

1700 

-27.40 

1750 

-27.20 

1800 

-26.80 

1850 

-26.44 

1900 

-26-.  30 

1950 

-28.20 

2000 

-26.08 

2050 

-26'.01 

2100 

-25.89 

I  i 
f  ' 


j  ’ 

'  J 


}  ' 

♦  i 

I 


5 


2300 

-25.52 

2350 

-25.44 

2400 

-25.39 

2450 

-25.29 

2500 

-25.25 

2550 

-25.19 

2600 

-25.24 

2650 

-25.10 

2700 

-25.20 

2750 

-24.99 

2800 

-25.00 

2850 

-24.91 

2900 

-24.93 

2950 

-24.93 

3000 

-24.94 

3050 

-24.95 

3100 

-24.87 

3150 

-24.80 

3200 

-24.80 

3250 

-24.69 

3300 

-24.62 

3350 

-24.59 

3400 

-24.56 

3450 

-24.53 

3500 

-24.51 

3550 

-24.42 

3600 

-24.39 

3650 

-24.39 

3700 

-24.38 

3750 

-24.33 

3800 

-24.30 

3850 

-24.30 

3900 

-24.27 

3950 

-24.28 

4000 

-24.23 

SPECTRAL  ATTENUATION 


FIBER  10:  Attenuator  calibration  for  ATTN  #4  17-MAR-90  14:54:53 
LENGTH:  0  kn 

WAVELENGTH  ATTENUATION  ( dB ) 


800 

-44.20 

850 

-42.82 

900 

-40.85 

950 

-37.31 

1000 

-34.65 

1050 

-32.77 

1100 

-31 .25 

1 150 

-30.09 

1200 

-29.17 

1250 

-28.54 

1300 

-27.85 

1350 

-27.47 

1400 

-27.62 

1450 

-28.99 

1500 

-26.67 

1550 

-31 .08 

1600 

-3r.13 

1650 

-31 .71 

i^ppendixR  InSb  Detector  Pireamp  Power  Supply  Circuit 


Praamp 
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Appendix  C.  Index  ofTechnical  Reports  and  Publications 


No  technical  reports  other  than  this  final  report  were  generated  during  the 
administration  of  this  contract. 

There  were  no  publications  generated  during  the  administration  of  this 
contract. 
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AppendixD.  3ystemSoftwaro listing 


Page  27 


t0  t******#********************#***********************^)*******)**!!****#****!* 

12  ! 

14  I  CopyriQht  Notif ic4tiont 

l€  I 

1§  I  COPYRIGHT  1985  PHOTON  KINETICS,  INC. 

20  I  ftll  hloHts  i"e8erv€d. 

22  !  ContninB  trtde  8«cr«ts  of  Photon  Kinetics,  Inc. 

24  •  Unauthori*«d  copylno,  use,  Modification  or  transfer  prohibited. 

28  i 

28  !  Extensive  Modifications  were  completed  in  April  1990  by  K.D.  Bennett 

30  !  ertd  R.S.  May  of  Uirpinia  Tech  for  the  Naval  Research  Laboratory  to 

32  1  cuStoMize  the  system  for  use  with  IR  fiber.  Also  towards  this  end, 

34  I  routine  INIT_FOA_CNTRL  was  added  by  C.S.S  of  P.K.  on  June  20th,  1989. 

38  I 

38  OUTPUT  KBD  USING  "t.K-rK" 

40  6CLEAR 

42  BEEP 


44 

46 

48 

50 

52 

54 

58 

58 

80 

62 

64 

66 

68 

70 

72 

74 

76 

78 

80 


PRINT  TABXY(5.8)rCopyrlght  1985/1989,  Photon  Kinetics,  Ino." 

PRINT  TABXY(  le.airAll  rights  reserved." 

WAIT  S 

OUTPUT  KBO  USING  “t.K'TK" 

rEM  +«*«•»***#*♦*****••********«••*♦*•*»**»**•****«*•**»**•»*"*♦***♦**•»»+ 

REM  +  FOA-2000  SYSTEM  SOFTWARE  6/20/89  C.S.S  VERSION  2.1IRP 

REM  +  Main  Program  "Mainprog" 

REM  +  PURPOSE: 

REM  +  This  is  the  main  program  that  calls  all  other 
REM  +  test  and  utility  modules.  It  sets  up  the  required  data 
REM  +  and  calls  the  initialization  routines  that  prepare  the 
REM  +  FOA-2000  system  for  measurements.  Then,  it  prints  a  menu 
REM  +  of  options  for  the  user  to  choose  from.  At  present,  the  nenu 
REM  +  contains  options  for  running  the  test  sequence  defined  by 
REM  +  the  user’s  FI8ERTEST  module,  setting  the  time  and  date, 

REM  +  inspecting  the  system  set-up  data,  and  archiving  measurement 
REM  +  results.  Other  options  can  be  added  easily.  * 

REM  + 


82  ! 

84  !  First  the  common  data  areas  are  set-up.  The  data  in  tliese  comncn 

86  t  areas  are  shared  among  many  routines  in  the  utility  software.  Thcy 

88  •  should  not  ba  changed  since  many  routines  reference  this  data. 

90  ! 

92  OPTION  BASE  0 

94  COM  /OlsKdrive/  Sysdrlve*t203  .AredriveSI 201 

96  COM  /lopeths/  tFea2000,tEgg52O5,0Tek78y4,@Bncdalay,Printer_add 

98  COM  /Previous/  Pr«vious*t801 

100  COM  /EggS2i5/  8c#Us(201,S€tile, INTEGER  Num^aver  .Range 

102  COM  /Sysdeta/  Serlal_nunef401  .LasarsfE)  ,Fi  lter_f  lag.FtltersC  11  )  .Num..focur. , 

FocUS<84  ,3)  .Cutoff ,Lsw_wave  ,High„wave  ,Det_Bwitch 

104  COM  /Syscal/  Pin„x  ,Pin„y  ,Pin_2  ,InX_Etsp  ,  Iny^stcp  ,0utx„5tep  ,0ut y.r. top  .farf  i 


114  COH  /Frequency/  Frequency<200),NuM_freQS 

116  CO«  /FarfUld/  Ffieldvel<200)  ,FnU«_point6  ,Farf  ield<  203 , 1  )  ,Ff  ield_id$C80  J 
118  COH  /Fftinpdeti/  Ffraudetdl 203 ,  li>  ,Ffdt f fdete( 203 , 1  )  ,Ff snoothdata( 203 , 1  ) 

120  COH  /Ferf iiid_iiave/  Ffwaveldn  < 

122  COM  /Speerundet#/  Specrundata<3S0,l ),Specrun_id$C80] 

124  COM  /Specrefdete/  Specr«fdata(3S0,1 ),Specref_idS[803 

126  COH  /Specettdata/  Specetid«ta(350,1 ) ,Specatt_id$t80] 

128  COM  /Dnadate/  D«arundata<3S0,1 1  )  ,Onarefdata<350, 1 1  )  ,Dmaattendata<  3SO..  1 1  )  ,D 
ma_idtC80} 

130  COM  /Direetref/  Specrefcorl  3S0 , 1 ) .Pulseref cor( 1 ,256 ,2  )  .Pulsecoruavel 2  )  ,Cor 
rect_f iag<2  > 

132  COM  /Puieerunda*a/  Pulaarundata(257 ,2 ) ,Pulserun_idS< 2  )t 80  3  ,Pul3erunwave< 2 ) 
,Num_ave*tC 10] ,Sye_delay 

134  COM  /Puieerefdata/  PuUerefdata<2S7,2>.Pulseref_idS(2)[80].Puiserefuiave(2) 
136  COM  /PuUaraeults/  Pulseresultl  1  ,256 ,2  >  .Pul5ere6_id*<  2  )t80]  ,Pulseresu.ave(2 
) 

138  COM  /Jlttercor/  Jittercor<256 > 

140  COM  /Nearfield/  Nf leldval(200 )  ,Nun_points ,Nearf leld< 200 , 1  )  ,Nf ield_id$[80] 

142  COM  /Otdrdata/  0tdr(2SS)  ,Otdr_ldit80]  ,Tiine_div 

144  COM  /Cutoff/  CUtraf<200,l  ),Culrasult(200,n,Cutoff_id$[80],Cutoff„uavc,Flr 

st  ,Laet , Slope .Intercept 

146  COH  /Uarap/  Uarap_idSC801 .Uarap^datal 1 . 16  )  .Varap_sn$t 403  ,Apcal_data( 2  15), 
Ap_nUM6( l5),Nun_ape 

143  COM  /Addition/  Curr_wava ,Grat ings( 10 > ,Cur_grat ing ,Wave_step 

150  ! 


152 

154 

156 

158 

160 

162 

164 

166 

168 

170 

172 

174 

176 

178 

180 

182 

184 

186 

188 

190 

192 

194 

196 

-6.2, 


!  N«>^t ,  the  various  devices  in  the  system  are  assigned  to  I/O  paths. 

!  After  these  assignments,  all  references  to  the  device  are  made  through 
•  the  appropriate  I/O  path  name.  These  path  names  and  their  character¬ 
istics  should  not  be  changed  unless  a  device  address  is  changed. 


I 
! 

Foaadres*5 
EQ0adre8»4 
Bncadres*! 5 
T7854adre5»10 

ASSIGN  8Foa2000  TO  700+Foaadres 
ASSIGN  0Egg5205  TO  700+Eggadre5 
ASSIGN  SBncdelay  TO  700+8ncadr€S 
ASSIGN  @Tek7854  TO  700+T7854adres 
DUMP  DEUICE  IS  PRT 
Printer_add-PRr 
PRINTER  IS  CRT 


lFOA-2000  primary  address 
IE6G-5207  primary  address 
IBNC  delay  primary  address 
•7854  primary  address 


•  Addrrs'i  of  dump  de/i-c 
•Address  of  pr  l  ntcr  :  f'P  1 -70 1 


The  Scale  factors  for  the  EGG5207  are  stored  in  a  common  array  in 
the  common  area  called  /Egg520S/.  These  scale  factor  valurs  are 
used  to  scale  readings  from  the  EGG5205  into  volts.  The  array  is 
initialised  here. 

DATA  2.5E-3,1E-3,.SE-3,2.SE-4.1E-4,.5E-4,2.5E-5,lE-G,.5E-5.2.5E-6 ,1E-S  ,.5E 
SE-7 , 1 E-7 , . 5E-7 ,2 . 5E“8 , 1 E-8 , . SE-8  .2 . 5E-9 . 1 E-9  , . 5E-9 


198 

200 

202 

204 

206 

208 

210 

212 

214 

216 

218 

220 


READ  Scales! •) 


•Read  scale  factors  into  an  array 


I  The  disk  drives  are  assigned  device  specifier  names  used  throughout 
I  this  Software  when  the  disk  drives  ero  acreBgflrj,  These  Hrfvp.  names 

•  are  sutomatlcally  derived  from  t.he  current  MSI.  This  may  be  inapprop- 
I  rlate  for  some  systems  where  MSI’s  are  changed  to  MEMORY  or  BUBBLE., 

I  If  this  is  the  case  then  change  these  lines  to  assign  these  direcly. 
t  Some  e^^amples  are 

I  9836:  5y6drive$*“s INTERNAL ,4,0"  ArcdrlveS^" : INTERNAL ,4 , 1 " 

•  8817:  Sy8driv#t*";HP9l22,701 .0"  Arcdrlve**" :HP9122 .700 , I" 

!  9816;  SySdrive*»'*!HP8290X,70l  ,0"  Aredrive*'-"  :HP8290X  ,701  . 1" 


Sy5$=^SYSTEM*<  "MSI"  ) 

Tr  nor  /  c, ,,.^f  DOC  /  c.  «  •> 


them  "t-c,, i-*r  t  pi'- '  c  .  rt!  ro'"' -'t 


i+i  1  “ 


•  ' 


230.  HASS  STOR<^  IS  Sysdrlv®* 

■  23Z  > 

23f’  •  It  thi  kiybdif'd  l«  a  46020^  keyboard  then  some  Ini-tialisation  should  be 

235  f  dsn*  do  H.  This  It  accombiished  autonatically  below. 

238  1  . 

240  STATUS  K8tJ,3iKey„id 
242  IF  BIT(K«y„id.5)  THEN 

244  CONTROL  K80. 14 10  iSct  not  fO 

246  OUTPUT  KBD  USINQ  "-K  iCHRfl 25S  )&CHR*< 1 23  )  !Put  function  keys  in  USER 
248  ENO  IF 
2S0  I 

2S2  I  If  BASIC  4,0  or  greater  is  running,  then  turn  on  the  display  conp- 
254  I  Stability  card  if  it  is  there. 

2S8  ! 

258  IF  UAL<SYSTEH»("UERSIONjBASIC")»*4.0  AMD  P0S< SYSTEM*! "CRT  THEN 

260  CONTROL  CRT  ,21 1 1 
282  END  IF 
264  I 

266  I  Now  the  initialization  routine  it  called  to  initialize  the  system. 

268  1  The  tyttan  data  file  it  read  in,  and  previously-neasured  reference 

270  !  data  it  trantfirrad  fron  the  system  disk  into  Common. 

272  ! 

274  Ini t SON  ERROR  GOTO  Sy terror 
276  CALL  Sytinit 

273  OFF  ERROR 

280  CALL  Menu 

282  60T0  Init 

284  ! 

236  !  We  get  an  error  when  attempting  to  call  SYSINIT  if  MAINPR06  is 

288  !  run  uithou  the  rest  of  the  system  software  package.  The  loadsub 

290  !  module  will  build  the  complete  FOA2000  file. 

292  ! !  THIS  IS  FOR  PHOTON  KINETICS  USE  ONLY  I ! 

294  ! 

296  Syten  orilF  ERRN*7  THEN 
298  OFF  KEY 

300  BEEP 

302  DISP  "Do  you  want  to  build  an  F2000SYSTEM  file'?" 

304  ON  KEY  S  LABEL  "  YES"  GOTO  Build 

306  ON  KEY  6  LABEL  "  NO  "  GOTO  Done 

308  Wait_here:60T0  Wait_here 
310  BulldtOFF  KEY 
312  DISP  "" 

314  GOTO  Init 

316  ELSE 

318  Main_err;BEEP 

320  DISP  "HAINPROG  —  "&ERRM* 

322  Dead is GOTO  Oeadi 

324  END  IF 

325  Done: DISP  "" 

328  END 

330  I 

332  I 

334  SUB  Sysinit 

336  !+#♦*»#***#****#*#*###*#**##*•♦#**»»****»»»»•***•»»*»♦»*»*»*'■''»*■»♦'■'>'"''■'■  + 
338  I  SYSTEM  INITIALIZATION  MODULE  UERSI0N2.1P 

340  I -»###*•##*#*##*»*»« *##•»##••»*#♦*#*»**»##♦»*•***»**»♦«♦*#♦*#»**•»♦*»»♦»- 

342  COM  /Oitkdrlve/  Sytdrtve* ,Arcdrlve* 

344  COM  /Sytdaia/  Serial^num* , Laser! *)  ,F1 lter_f lag  ,Fi Iteri *)  ,Num_facus  .Focus 
!  ♦  )  .cutoff  ,Low_Mev#.iMlgh_wave  ,Det_swl  tch 

346  COM  /Syeeal/  Pin^x  ,Pin_y  ,Pln_z  ,In>;..3tep  ,Iny_step  ,Oulx„.step  ,Outv...steD  .Far 

f ield_step .Lfhoite 

348  COM  /Oireetref  /  Specrefcor!  *  )  .Pulseref cor!  *  >  ,Pu I secorwavc!  '  >  .C-'r rcc  i..!  I" 


3S4  COM  /Paisarundata/  PulserundataC * ) .Puleerun  id$< •  L.Pulserunyavc? • ) ,Num_a 
V«f|tf®l,Ss^OaUy 

sis  COM  /Jittareor/  Jlttarcor<*) 

3S8  COM  /ftddltidh/  Curr_wave  ,6rating6<  *  )  ,Cur_gratlng  ,Wiave_step 
360  DIM  FiUnaMaftaei  .Tenp<  I  .256  > 

362  MBORT  7  ISand  IFC  (Interface  Clear)  on  GPIB 

364  eCLEMR 

366  STATUS  KiD.StMey.id 

368  I 

370  I  If  the  nuMbar  of  pulse  averages  has  not  been  set,  default~400 
372  I 

374  IF  NuM_ave8f»"“  THEN  NuM_ave8S»"4  0  0" 

376  CALL  Init_foa_cntrl  !Set  the  FOA-2000’s  controller  to  new  mono  stuff 
378  ! 

380  !  Now  check  to  sea  If  the  user  wants  to  load/reload  user  routines. 

382  I 

384  ON  ERROR  GOTO  Fila.arror 
386  Load_set!OFF  KEY 

388  Fi lenane**" foasetup"  'Set-up  file  name 

390  DISP 

392  INTEGER  Index 

394  I 

395  !  Now  read  the  FOA-2000  set-up  file  called  "foasetup" 

398  • 

400  RaadsetuptASSIGN  ©Setupfile  TO  Fi lename*&Sysdrive$ 

402  ENTER  ©SetupflleiVerslon*  IChccK  the  setup  file 

404  IF  NOT  POS(Uerslont,“UERSION" )  THEN 

406  BEEP 

408  PRINT  TABXY<5,10)r'Th0  set  up  file  on  this  disi’  is  the  wrong  version," 

410  PRINT  TABXY<5,I t  )?“6Ub  SYSTEMOATA  should  be  called  to  update  it,  (wave 

length  llMits  and' 

412  PRINT  TABXYt 5 , 1 2  ) » "machine  serial  number  I.O.  should  be  added)." 

4)4  PRINT  TABXYt 5,14)1 "Other  data  will  be  read  anyway." 

416  WAIT  5 

4)8  OUTPUT  KBD  USING 

420  ASSIGN  OSetupfile  TO  • 

422  ASSIGN  ©Setupfile  TO  FilenameS&Sysdrivc® 

424  GOTO  Vlfile 

426  ELSE 

428  Uer8lon_num=^UAL<  UersionStPOStUersionT  ,  "I'ERSIOM"  X-Sl  ) 

430  IF  Uer6lon_num<2  THEN 

432  PRINT  TABXY<5,I0)rThi6  set  up  file  is  not  current." 

434  WAIT  3 

436  OUTPUT  KBD  USING  "#,K"j"K" 

438  END  IF 

440  END  IF 

442  ENTER  ©Setupf ilejSerial_num$ 

444  ENTER  ©SetUpf i leiLow_wave ,High_uave 

446  UlfilesENTER  ©Setupf ile»Laser( *  ) 

448  ENTER  ©Setupf lleiFilter_f lag 

450  ENTER  ©Setupf i leiFi lter< * > 

452  ENTER  ©Setupf lleiNum_focus 

454  ENTER  ©Setupf ileiFocust*) 

458  ENTER  ©Setupf ileiCutoff 

458  ENTER  ©Setupf lleiPin.x .Pin.y  ,Pin_2 

460  ENTER  ©Setupf llej Inx_step  ,Iny_step 

462  ENTER  ©Setupf llefOutx^step ,0uty_step 

464  ENTER  ©Setupf iJeiFarfield_step 

466  ENTER  ©Setupf i letLfnoiee 

468  IF  V#rslen_nym>2  THEN 

470  ENTER  ©Setupf lie iDat_3u itch 

472  ELSE 

n..f  t  -H-t  ^  '  1 


'Get  the  machine’s  S/N 
'Wavelength  limits 
■Get  the  laser  wavelengths 
■Get  the  filter/mono,  flag 
■Read  entire  filter  table 
!Get  number  of  focus  values 
'Get  the  focus  table 
(Cutoff  switch  wavelength 
■Get  pinhole  position 
IGet  Input  stage  step  size 
■Output  stage  step  size 
•Get  farfield  step  size 
■Low  freq.  detector  noise 
■Uersion  2.1  or  later. 
•Detector  switch  wavelength. 

*  1  -I-" 


4  *7  4 


4  ..  1. 


V  V/ 


482  !  Next,  read  the  insertion  delay. 

484  ! 

486  Read_deley!File.nan€*=»'’pulsedeiay" 

488  ftSSISN  •DeUyflle  TO  "pUlsedelay" 

490  ENTER  COeUyf  i  le»Sys_delay 

492  ASSIGN  «Oelayfile  TO  * 

494  Read_J ittersFilendwet*" j ittercor" 

496  ASSIGN  ®Jittercor  TO  "Jittercor" 

498  ENTER  fJlttercori Jittercor( »  ) 

500  ASSIGN  ejlttercor  TO  * 

502  ! 

504  I  Next  read  the  variable  aperture  calibration  data. 

506  I 

508  Readvarapca I s  F i lanamet* " varapca 1 " 

510  ASSIGN  SUahapfile  TO  FilenanetSSysdriveS 

512  ENTER  flUarapf ila»Uarap_sn$ 

514  ENTER  9Uarapfile»Apcal_data( * ) 

516  ASSIGN  @Oarapfila  TO  * 

518  I 

520  I  Next,  read  the  Spectral  Attenuation  direct-spot  correction  data 
522  ! 

524  ReadspeccorsFi lenaMa**»''6peccor“ 

526  ASSIGN  @Specreffile  TO  Fi lename$&Sysdr iveS 

528  ENTER  9Specraf f i le»Spacrefcor< •  ) 

530  ASSIGN  espacreffila  TO  * 

532  ! 

534  1  Read  the  Swept  frequency  direct-spot  correction  data  for  all  3  lasers 

536  ! 

538  Readpulse:FOR  Jindex*0  TO  2 

540  Fi  lenaMe**'‘pul6eoor"8.UAL$<  Jindex+ 1  ) 

542  ASSIGN  SPulseref f lie  TO  Fi lenaneS&Sysdr ive$ 

544  ENTER  ©Pulseref  f  ile;Tetnp{  *  ) 

546  ENTER  @Pulsereff  ilaiPulsecorwaveC Jindex  ) 

548  FOR  lndex*=0  TO  256 

550  Pul  sere f cor <  0 .Index ,J index )-Tenp( 0 .Index  ) 

552  Pulserefcor( 1  .Index  . Jindex  )=Tenp< 1  .Index  ) 

554  NEXT  Index 

556  ASSIGN  @Pulseref f ile  TO  ♦ 

558  Readpuls€_1 :  NEXT  Jindex 

560  GOTO  Done 

562  Fiie_error;  SELECT  ERRN 

564  CASE  56 

566  SELECT  Filename* 

568  CASE  "foasetup" 

570  BEEP 

572  PRINT  TABXYl 1  .I7)i"Thc  FOA-2000  set-up  file  docs  not  exist  on  the  di 

sK  in  the  primary" 

574  PRINT  TABXY<  1  . 1 8  )  j  "disl”  drive.  Please  insert  the  system  software  dis 

k  and  press  PROCEED." 

576  ON  KEY  5  LABEL  "PROCbtD^'  GOTO  Ready 

578  Wait_2:  GOTO  Wait_2 

580  Raady:  OFF  KEY 

582  GOSUB  Clr_screen 

584  GOTO  Readsetup 

586  CASE  "pUlsedelay" 

588  Sys_delay*40 

590  GOTO  Read_Jitter 

592  CASE  "Jittercor" 

594  GOTO  Readvarapcal 

596  CASE  "varapcal" 

598  GOTO  Readspeccor 


U^o 


Wl 


J  W  Wl 


-  « 


S12  DISP  "The  ""USER""  file  was  not  found  on  this  .disK" 

G!4  ON  KEY  5  LABEL  "RE-TRY"  GOTO  Load_user 

81B  IF  BIT<Key_id,5>  THEN 

GIB  ON  KEY  G  LABEL  "LOAD  AL-TERNATE"  GOTO  Try_again 

S20  ELSE 

G22  ON  KEY  S  LABEL  "LOAD  ALTERNATE"  GOTO  Try.again 

G24  END  IF 

B2G  GOTO  Wait_3 

G28  CASE  ELSE 

G30  BEEP 

S32  DISP  Filenane$»"  was  not  found." 

634  ON  KEY  S  LABEL  "RE-TRY"  GOTO  Try.again 

B36  IF  BIT<Key_id,G)  THEN 

B38  ON  KEY  G  LABEL  "LOAD  DEFAULT"  GOTO  Default 

640  ELSE 

G42  ON  KEY  6  LABEL  "LOAD  DEFAULT"  GOTO  Default 

644  END  IF 

G4G  Walt_3:  GOTO  Wait_3 

G48  Tl"y_aQaifisCAT  Sysdrive* 

B50  GOTO  Load_alt 

652  Default :FilanaMe*»"USER" 

654  GOTO  LQad_user 

65G  END  SELECT 

658  CASE  7  >  Call  to  an  undefined  subprogran 

660  GOTO  Skip_del 

662  CASE  80  '  Disk  not  installed 

GG4  BEEP 

666  DISP  'There  is  no  disk  in  the  disk  drive.  Please  install  the  disi  and 

press  proceed." 

668  ON  KEY  5  LABEL  "PROCEED"  GOTO  Proceed 

670  Walt_4  OTO  Wait_4 

672  Proceed:SELECT  Filenames 

674  CASE  "foasetup" 

676  GOTO  Readsetup 

678  CASE  "varapcal" 

680  GOTO  Readvarapcal 

682  CASE  "speccor" 

684  GOTO  Readspeccor 

686  CASE  "pulsecor!  "  .''pulscoorZ"  ,"pul5Ccor.V’ 

688  GOTO  Readpulse 

690  CASE  "USER"8.Sysdrive$ 

692  GOTO  Load_user 

694  CASE  ELSE 

696  GOTO  Load„alt 

698  END  SELECT 

700  CASE  ELSE 

702  BEEP 

704  DISP  "SYSINIT  —  Error  number  "8,UAL$(  ERRN ) 

706  Dead1:60T0  Dead! 

708  END  SELECT 

710  Clr_5crs5n^0UTPUT  KBO  USING 

712  RETURN 

714  Done:SUBENO 

716  1 

718  SUB  Systemdata 

720  I  •f###**#*#»#»***«  *•*#<###»»#***********♦***•»»••»*•*•♦*♦*♦»*»•**  **'*******  + 
722  !  EXAMINE/MOOIFY  SYSTEM  DATA  MODULE  'v'ERSION  2.1 

724  I 
726  1 

728  I  INITIALIZATION 

730  ! 


f \  f  t  *  n  :  .  »  .4 , 


C  *  4.  .  -  -1^.  .  f(t 


^  WUII  f  siy  L  t  r  ^  **4*y  **  ^  *  *•— *•  ^  ,r\J  •.  <,  >;  ji  .1 

flfild^*tep  ,Lf  noise 

?38  OIH  Fllina««$t2SJ.Tltl«il2001,K«y8*<l!20)C16J 
74«  !S«i  key  libei  date  for,  16’S  and  J7’s 

742  OitatSsOftTA  QUIT  .PRINT  DATA.HOQTFY  DATA  .SHOW  CAL  DATA*, RETURN  TO  HENU  .PRINT  C 
AL  MTA.CHANSE  LASERS .USE  MONOCHRO.  JHANSE  FILTERS  .USE  FILTERS 
744  DATA  USE  CUTOFF  FIL, MOO/DEL  CUTOFF  , HOD  WAUE  LIMIT  . ADD  CORR  UALUE  .DEL  COR 
R  UALUE .MOD  CORR  VALUE .DISPLAY  DATA .FILTER  WHEEL  .MONOGHROMATER .CHANGE  SERIAL  f 
746  Oatal7sOATA  OUIT .PRINT  DATA  .MODIFY  DATA, SHOW  CALDATA  .RETURN  TO  MEMU.PRIN 
T  CAL  DATA  .CHANGE  LASERS  .USE  MONOCRM.  .CHANGE  FILTERS  .USE  FILTERS 
748  DATA  USE  CUT-OFF  FIL.  ,MOO/OEL  CUTOFF  .MOD  WAUELIMITS  .ADD  CORRUALUE  .DEL  CO 
RRUALUE.MOD  CORRUALUE  .DISPLAY  DATA  .FILTER  WHEEL  .MONOCHR-OMATER .CHANGE  SERIAL  I 
7B0  » 

752  I  If  coMputer  la  a  9816/36  then  read  the  first  set  of  key  labels  otherwise 
7S4  !  read  tha  second  set  of  key  labels. 

756  f 

758  RESTORE  Data  16 

768  STATUS  KB0.9|Key^id 

762  IF  BIT<Key_ld.S>  THEN  RESTORE  Data  17 

764  READ  Keys«( »  ) 

766  ! 

768  1  Uriie_flag  le  sat  if  any  system  data  is  modified,  to  indicate 

770  I  that  the  foasetup  file  must  be  purged  and  re-written. 

772  1 

774  Writa_fiag»0  <Clcar  re-write  foasetup  flag 

776  Filename**" foasetup "iSysdrive*  ISet-up  file  name 

778  INTEGER  Index 

780  ! 

782  !  Display  the  system  data  on  the  CRT  (excluding  calibration  data) 

784  I 

786  SOSUB  Sys.di splay 

788  ! 

790  !  Now  ask  tha  user  what  to  do 

792  ! 

794  Sys_menu:BEEP 

798  ON  KEY  1  LABEL  K6y8S(20)  GOTO  Change.sn 

798  ON  KEY  5  LABEL  KeysS( I  )  GOTO  Sys_done 

800  ON  KEY  G  LABEL  Keys*(2)  GOTO  Prtnt_5crn 

802  ON  KEY  7  LABEL  Keys*(3)  GOTO  Call_mod 

804  ON  KEY  8  LABEL  Keys*<4)  GOTO  Call_cal 

806  Wait^menusGOTO  Walt_nenu 
808  Change_8n:0FF  KEY 
810  DISP  "" 

812  Wrlte_flag»l 

814  INPUT  "Enter  a  serial  number  or  new  identifier:  "  ,Sorial_num$ 

816  GOSUB  Sys.dl splay 

818  GOTO  Sy6_menu 

820  Print_scrn:OFF  KEY 
822  DUMP  ALPHA 

824  GOSUB  Clh_screen 

826  GOSUB  Sy8_display 

S2S  SOTO  Sys_«-nu 

830  Call_mod:OFF  KEY 
832  GOSUB  Sys.modify 

834  GOSUB  Clr_screen 

836  GOSUB  Sys_dl splay 

.838  SOTO  Sys.mcnu 

840  CaU_cal:OFF  KEY 
842  G0SU8  6y8_eal 

844  GOSUB  CIr_screan 

846  GOSUB  Sys_di splay 

848  GOTO  Sys_menu 

8=50  Clr_screen; OUTPUT  KBD  USING  "*,K‘'rK'’ 

nrTiinii 


8B0  Sys_dtsplayi  60SUB  Clr_screen 

862  OISP  *"  iClear  the  display  line 

86«  PRINT  TReXY<S,t  )fCHR*<t29)t"  FOA-2000  SYSTEM  CONFIGURATION:  MACHINE  SERI 

AL  NUMBER  "ISariil^nuMfiCHRSl 128 ) 

866  PRINT 

868  PRINT  CHRt< 132) rwavalangth  Range; "»CHRS( 128  )&"  " ;UAL*<Low_wave  )» "  nn  to 

" tMAL*<High_wav« )i *  nn.  Detector  switch  at  “ tUAL$(Det_5ultch  );"  " 

870  IP  Fllter^flag®!  THEN 

872  PRINT  CHRS{132)j"  FILTER  UHEEL  WAVELENGTHS 

"iCHR*(128) 

874  PRINT  CHRft  l32)t“Fiitep"iCHRt( i28){"  " iCHR$(l 32  )  i "Wavelenath" iCHRSi 1 2 

8);“  "  »CHRt<  132  )rFllter"tCHR*(  128)1"  "iCHR$(l32)t 

876  PRINT  “Wavelength" |CHR»< 128)1"  "?CHR$<132)j”Filter"iCHR$(128)r' 

"|CHR$<  132)rWavelength"»CHR*<  128) 

878  FOR  Index-0  TO  3 

880  PRINT  USING  "2X  ,20  ,BX ,40. 13X ,2D .6X ,40 , 1 3X  ,2D ,BX ,40" f Index .Fi 1 teri Ind 

ex  ),Index+4,Fiitep( Index+4  )  ,Index+8.Filter( Index+8  ) 

882  NEXT  Index 

884  ELSE 

886  PRINT 

888  IF  Fllter_flag«2  THEN 

890  PRINT  "Monochroneter  installed  and  cutoff  filters  are  being  used." 

892  ELSE 

894  PRINT  “Monochroneter  installed  but  cutoff  filters  not  being  used," 

896  ENO  IF 

898  PRINT 

900  END  IF 

902  PRINT  CHR*< 132  )i"  CORRECTION  VALUES 

"  128) 

904  PRINT  CHRS  13  "Wavelength  X  Y  Z" tCHR$( 1 28 > ; ”  " ;CHR$n 32 ) ("Wave 

length  X  Y  Z"u  •(128)r  "«CHRS<132)t 

906  PRINT  "Wavelenv  X  Y  Z"jCHR$(128) 

908  FOR  Index-0  TO  21 

910  PRINT  USING  "3X  ,40  ,3X  ,30  ,2X  ,30 ,2X  ,40  iFocusi Index  ,0  )  .Focus' Index  ,  1  ) , 

Focusi Index ,2 ) ,Focus< Index ,3 ) 

312  PRINT  USING  "4X  ,40  ,3X  ,30  .2X  ,30 ,2X  ,40  ; Focusi Index ♦ 22 ,0 ) .Fncus ( I nde -  + 

22  ,t  )  ,Focus< Index+22 ,2  )  .Focus! Index+22 ,3 ) 

914  IF  Index<21  THEN 

91G  PRINT  USING  "4X  .40  .3X  ,30  .-ZX  .30  .2X  ,40"  sFocus!  Index  +  44  ,0  )  ,Focus(  Index  + 

44,1) , Focus! Index+44 ,2 ) .Focus!  Index +4 4 ,3 ) 

918  END  IF 

920  NEXT  Index 

922  RETURN 

924  I 

926  •  Display  Calibration  Data 

928  ! 

930  Sys_cai :G0SUB  Clr_screen 
932  OISP  "" 


934  PRINT  TABXY!2S,1  )»CHR$! 129)?"  FOA-2000  CALIBRATION  CONSTANTS  ";CHR$()28) 
936  PRINT 

938  PRINT  TABXY!33, 3  )?CHR*! 132)1 "PINHOLE  POSITION" ;CHR*(1 28  ) 

940  PRINT  TABXY!23,S)r'Pln_x:  "?Pln_x?"  Pin_y:  ";Pin..yi"  Pin_c:  "iPifi...' 

942  PRINT  TABXY<30,7)?CHR*!l32>?"FliER  STAGE  STEP  SIZE" ;CHR$! t 28 ) 

944  PRINT  TABXY!8,9)? ''Inx_step:  "?Inx_step?"  Iny_5tep:  "!lny_step?"  0ut,'.„5t 
ep;  " ?0utx_st#pi “  0uty_8tep:  "iOuty_step 

946.  PRINT  TABXY!25.tl  )?CHRt! 132)?"FAR-FIELD  RESTRICTOR  STEP  SIZE" iCHR$( 128  ) 

948  PRINT  TA6XY<28,t3)i"Farfieid_step;  " iFar f leld„step 

950  PRINT  TA8l!Y! 26, 15 )!CHRt!  132)?  "LOW-FREQUENCY  dEtECTOR  NOISE"  ?CHR$!  1 28  ) 

952  PRINT  TABXY!28,17>?"Lfnolse;  "?Lfnoise 

954  ON  KEY  5  L^Et  Keyst<5)  60T0  Cal_done 

956  ON  KEY  8  LABEL  Keys»<6)  60T0  Cal  print 

958  Walt„calsSOTO  Walt  cal 


i  \U.  )  UMi  t 


'968'  I 
^70  !  Modify  th«  Systan  data 

,172  I 

174  Sys  ModifysSOSUS  Clr  Screen  * 

97B  BE6P 

978  OM  ERROR  SOSUB  Input_error 

980  t 

982  I  Modify  menu 

984  I 

988  ON  KEY  5  LABEL  Keys$(7)  GOTO  Mod_lasers 

988  SELECT  Filter.flaQ 

990  CASE  ! 

992  ON  KEY  8  LABEL  Key8$<8)  GOTO  U5e_mono 

994  ON  KEY  7  LABEL  Keys*? 9)  GOTO  Mod_f liter 

998  CASE  0 

998  ON  KEY  8  LABEL  Keys*? 10)  GOTO  Usa.filtcr 

1000  ON  KEY  7  LABEL  Keys*? 1 1  )  GOTO  Use.cutoff 

1002  CASE  2 

1004  ON  KEY  6  LABEL  Keys*? 10)  GOTO  Use_f liter 

1008  ON  KEY  7  LABEL  Keys*? 12)  GOTO  Mod_cutoff 

1008  END  SELECT 

1010  ON  KEY  1  LABEL  Keys*? 14)  SOTO  Add_corr 

1012  ON  KEY  2  LABEL  Keys*? 15)  GOTO  O€l_corr 

1014  ON  KEY  3  LABEL  Keys*?  13)  GOTO  Mod_highloui 

1018  ON  KEY  4  LABEL  Keys*? 18)  GOTO  Hod_corr 

1018  ON  KEY  8  LABEL  Keys*? 17)  GOTO  Mod_dona 

1020  Wait_!nod:SOTO  Wait_Mod 

1022  I 

1024  !  Modify  laser  wavelengths 

1026  ! 

1028  Mod_lasers:OFF  KEY 
1030  DISP  "" 

1032  Wrlte_flag*l  'Set  flag  to  re-write  foasetup 

1034  BEEP 

1038  ON  KEY  5  LABEL  "LASER  1"  GOTO  Laser_l 

1038  ON  KEY  6  LABEL  "LASER  2"  GOTO  Laser_2 

1040  ON  KEY  7  LABEL  "LASER  3"  GOTO  Laser_3 

1042  Wait_las;GOTO  Wait_las 
1044  La5er_1:0FF  KEY 
1048  BEEP 

1048  INPUT  "Enter  the  new  wavelength  for  laser  1  in  nanometers:  ".Laser?©) 
1050  GOTO  Check 

1052  Laser_2:0FF  KEY 
1054  BEEP 

1056  INPUT  "Enter  the  new  wavelength  for  laser  2  in  nanometers:  "  .Laser? 1  ) 
1058  GOTO  Check 

1080  Laser_3!0FF  KEY 
1062  BEEP 

1084  INPUT  "Enter  the  new  wavelength  for  laser  3  in  nanometers:  ".La5er?2) 
1088  GOTO  Check 


I uDo  unecK:DIc)r  uu  you  wunt  to  change  another 
1070  BEEP 


'rtlnrvofK?' 


1072  ON  KEY  5  LABEL  "YES"  GOTO  Mo d_ la sens 

1074  ON  KEY  6  LABEL  "NO"  GOTO  Mod„done 

1076  Wait_chk;GOTO  Wait_chl' 

1078  ! 


1080  !  Modify  the  filter  flag:  If  set,  clear  it?  if  clear,  set  it. 

1082  ! 


1084  Use_mono;0FF  KEY 
1088  DISP  "* 

1083  Write_flag=t 

1090  Fllter_ f lag®0 


•Set  re-write  fhag  to  rewrite  fooeetup 
'Clear  fllter^flaq  ?ur,e  nono-hr  one  ♦  or  ) 


I  Jw 


wi  A  << 


1100  Fllt«r_f lag=l  iSet  filter_flag  (use  filter  wheel) 

1 1 02  Goto  Htjd_ddn6 
1104  Oia.cutoffiOFF  KEY 
1106  OISP  "" 

1108  «rlt«_fU0*l 

1110  Fi laQ*2  •Filter_f lag®2  (mono  w/  cutoff  filters) 

1112  GOTO  Hod_dofid 

1114  ttod_highlousOFF  KEY 

111G  DISP 

1118  Write_fla3*1 

1120  BEEP 

1122  INPUT  “Enter  the  new  low  waveTength  range  limit:  " ,Lou_wave 

1124  INPUT  "Enter  the  new  high  wavelength  range  limit:  ,High_wave 

1126  INPUT  “Enter  the  new  detector  switch  wavelength:  "  ,Det  switch 

1128  GOTO  Mod.done 

1130  Mod_cutoff :0FF  KEY 
1132  DISP  "" 

1134  Write^flag=l 

1136  Cut_off: INPUT  "Enter  wavelength  to  switch  the  cutoff  filters,  (entering  0  w 
ill  cancel  cutoff):  ".Cutoff) 

1138  IF  Cutoff 1»0  THEN 

1140  Filter_flao=0 

1142  ELSE 

1144  IF  Cutoff  1  <Low_uave  OR  Cutoff r>Mlgh_wave  THEN 

1146  BEEP 

1148  DISP  "Cutoff  filter  switch  point  must  be  between  "8iUAL$( Low_wave  >&" 

and  “8iVAL$( High_uave  )&"  nm." 

1150  WAIT  3 

1152  GOTO  Cut_off 

1154  ELSE 

1156  Cutoff»Cutoff 1 

1158  END  IF 

1160  END  IF 

1162  GOTO  Mod.done 

1164  I 

1166  I  Modify  filter  wavelengths 

1168  I 

1 170  Mod_fi Iter; OFF  KEY 

1172  DISP 

1174  BEEP 

1176  Write_flag=l  iSet  flag  to  rewrite  foasetup 

1178  INPUT  "Enter  the  filter  number  (0-1 1)  you  want  to  change:  ",Filter_num 

1180  IF  Filter_num>1 1  OR  Filter_num<0  THEN  GOTO  Mod_f liter 

1182  BEEP 

1184  INPUT  "Enter  the  new  wavelength:  "  ,Fi  1  tcr(  Fi  ltcr_num  ), 

1186  DISP  “Do  you  want  to  change  more  filter  wavelengths?" 

1 1 88  BEEP 

1190  ON  KEY  5  LABEL  "YES"  GOTO  Mod_filter 

1192  ON  KEY  6  LABEL  "NO"  GOTO  riod_done 

1194  Walt_fil;G0T0  Wait„fll 
1196  i 

1198  I  Modify  a  correction  value 

1200  t 

1202  Mod_corr:0FF  KEY 

1204  DISP  "" 

1206  Write_flaQ=)  ISet  flag  to  rewrite  foasetup 

1208  Try_again!BEEP 

1210  INPUT  "Enter  the  correction  wavelength  you  want  to  modify:  '.Wavelen 

1212  DISP  I  Clear  error  messages 

12)4  FOR  lndex»0  TO  Nun_focu5 

1216  IF  Wavelen«Focus( Index ,0)  THEN  GOTO  6et_new 

1218  NEXT  Index 


* 


n  r  r 


I  Ci-t  Uf  t  C.I\IVUI\ 

122B  GOTO  Sys  modify 

1223  Gtt.ndwsBESP 

1230  INPUT  "EntSf  the  new  X-a^ie  correction  value:  "  ,Facus( Index , 1) 

1232  BEEP 

1234  INPUT  “Enter  the  new  Y-a^iS  correction  value:  “  ,Focus< Index ,2  ) 

1 233  BEEP 

1238  INPUT  "Enter  the  new  Z-axis  correction  value:  "  ,Focus( Index  ,3 ) 

1240  Focus! Index ,0 >®Wavelen 

1 242  GOTO  Mod_done 

1244  ! 

1246  I  Delete  a  correction  value 

1248  I 

1250  Del_corr:OFF  KEY 

1 252  BEEP 

1254  Writa_flag=1  iSet  flag  to  rewrite  foasetup 

1253  INPUT  "Enter  the  wavelength  of  the  correction  value  you  want  to  delete", 

Uavelen 

1258  FOR  Index-0  TO  Nun_focus  iFind  the  one  to  delete 

1230  IF  Wavelen=Focus( Index  ,0)  THEN  GOTO  Delete 

1232  NEXT  Index 

1234  BEEP 

1233  DISP  "SYSTEM  DATA — The  specified  wavelength  is  not  in  the  correction  tab 

le." 

1 238  OFF  ERROR 

1270  GOTO  Sys_modify 


!  Delete  the  correction  entry  by  moving  the  rest  down  by  1 


1278  Delete:FOR  Index*Index  TO  Num_focu8-1 
1280  Focus! Index ,0  >*Focus! Index+1  ,0 ) 

1282  Focus!  Index , 1  )*Focus! Index+1  ,1  > 

1284  Focus! Index ,2  )«Focu8! Index+1  ,2  ) 

1283  Focus! Index ,3  l^Focus! Index+1  ,3  ) 

1288  NEXT  Index 

1290  Focus! Index ,0  )*0 

1292  Focus! Index , 1  )*0 
1 294  Focus! Index ,2 )*0 

1293  Focus! Index ,3  )*0 

1298  Nun_focus®Num  .focus-1  h 

1 300  GOTO  Mod.done 

1302  ! 

1304  '  ADD  A  NEW  CORRECTION  UALUE 

1303  ! 

1308  Add_corr:OFF  KEY 

1310  DISP  "" 

1312  IF  Num_focus=^19  THEN 

1314  BEEP 

1313  DISP  "SYSTEMDATA  —  The  correction 


•And  decrement  the  count 


The  correction  table  is  full,  delete  an  entry  firs 


1320  GOTO  Sy6_modify 

1322  END  IF 

1324  BEEP 

1323  Writ#_flag«l  !Set  flag  to  re-uri^e  foasetup 

1328  INPUT  "Enter  the  new  correction  wavelength:  ".Wavelen 

1330  IF  Wavelen<800  OR  Uavelen>l5O0  THEN 

1332  BEEP 

1334  DISP  “SYSTEMDATA  --  Correction  wavelengths  must  be  between  800  and  180 

0." 

1 333  OFF  ERROR 

1338  GOTO  Sys_wodify 

1340  END  IF 


Za^i  5 


1350  BEEP 

13S2  INPUT  “Entiif*  the  new  Z-axis  correction;  " 

13S4  t 

1356  I  Find  the  place  to  put  the  neu  correction  values 

!358  I 

1360  FOR  Inde>5*0  TO  NuM_focus 

1362  IF  Focus! Index ,0T>Wavelen  THEN  SOTO  Add 

1364  IF  Focus! Index  ,0  )=Wavelen  THEN  SOTO  Replace 

1366  NEXT  Index 

1368  ! 

1370  I  Now  Make  room  for  the  new  value  by  shifting  up  by  i 

1372  I  . 

1374  AddtFOR  Ix=NuM_focu6+l  TO  Index+1  STEP  -1 
1376  Focus! Ix ,0)*Focus( Ix-t  ,0) 

1378  Focus! Ix ,1 )=Focus! Ix-1  ,1  ) 

1380  Focus! Ix  ,2  )=Focu6! Ix-1  ,2  ) 

1 382  Focus!  Ix ,3 )=Focus( Ix-1  ,3 ) 

1384  NEXT  Ix 

1386  ! 

1388  !  Add  the  new  value  and  update  the  count  (nuM_focu5) 

1390  ! 

1392  Focus! Ix ,0 >=Wavelen 

1394  Focus! Ix ,1  l^Xaxis 

1396  Focus! Ix  ,2  )*Yaxi3 

1398  Focus! Ix ,3  )=Zaxis 

1400  NuM_focus=NuM_focus+ 1 

1 402  SOTO  Mod_done” 

1404  T 

1406  !  If  the  specified  wavelength  already  exists,  replace  it 

1408  ( 

1410  ReplacetFocus!  Index  ,0)»Wavelen 
1412  Focus! Index ,1  )»Xaxls 

1414  Focus!  Index ,2  )®Yaxi3 

1416  Focus! Index ,3  )*Zaxis 

1418  Mod_done:0FF  ERROR 
1 420  RETURN 

1422  I 

1424  !  This  code  is  executed  if  the  set-up  file  does  not  exist 
1426  1  and  the  user  wants  to  create  one. 

1428  I 

1430  Sys_create;60SUB  Clr_screen 
1432  OFF  ERROR 

1434  ON  ERROR  SOSUB  Input_error 

1 436  OFF  KEY 

1438  Write_fiao=2  ISet  flag  for  creating  a  neu  foase 

1 440  BEEP 

1442  INPUT  "Enter  the  machine’s  serial  number:  " ,Serial_num$ 

1 444  BEEP 

1446  INPUf  “Enter  the  low  wavelength  range  linit:  " ,Lou_uave 

1448  BEEP 

1450  INPUT  "Enter  the  high  wavelength  range  limit:  " ,High_uave 
1 452  BEEP 

1454  INPUT  "Enter  the  detector  switch  wavelength:  " ,Det_suitch 
1 456  BEEP 

1458  INPUT  "Enter  the  laser  1  wavelength:  ",Laser!0) 

1460  BEEP 

1462  INPUT  "Enter  the  laser  2  wavelength:  " .Laser! 1  > 

1464  BEEP 

1466  INPUT  "Enter  the  laser  3  wavelength:  ",Laser(2) 

1468  BEEP 

1470  DISP  “Does  the  system  have  a  filter  wheel  or  monochromator'?'' 


1482  Goto  F_.corr 
1484  Set_flasjtOFF  KEY 
f48t  Fliter_flaQ»l 
14¥8  for  TO  It 

1490  SEER 

1492  PRINT  TAB)(Y<  I  ,18>!"Enter  the  wavelength  of  filter  "ilndex  +  1i":  “ 

1494  INPUT  Fiiterl Index) 

1496  NEXT  Index 

1498  F_eorf*!S0SU8  Clr_screen 

1500  PRINT  TftBXYt I  ,  1 8  ){ "Do  you  want  to  create  a  correction  teble?" 

1502  ON  KEY  S  LABEL  "  YES"  GOTO  Yes 

1504  ON  KEY  8  LABEL  “  NO"  GOTO  No 

1508  Wait_cor;GOTO  Wait.cor 

1508  Yes ! OFF  KEY 

1510  GOSUB  Clr_screen 

1512  INPUT  "Enter  the  number  of  correction  points.  " ,Num_focu5 
1514  DISP  "*  IClear  error  message 

1516  IF  NuM_focus>20  THEN 

1518  BEEP 

1520  DISP  "SYSTEMDATA  —  The  maximum  number  of  correction  points  is  G4." 

1522  GOTO  Yes 

1524  END  IF 

1526  Num_foeus»Num_foeu6-l 

1528  PRINT  TABXY(40,8>5"NOTE" 

1530  PRINT  TABXY< 5 ,9 ) j "Correction  values  must  be  entered  in  ascending  order  f 
rom" 

1532  PRINT  TABXYtS  ,10 )» "the  lowest  wavelength  to  the  highest  wavelength  value 

(I 

1534  FOR  lndex*0  TO  Num_focus 

1536  PRINT  TABXYt I  ,  1 8 )  I "Enter  the  wavelength  for  correction  point  ";Tndex+l 

1538  INPUT  Focust Index ,0) 

1540  GOSUB  Clr.screen 

1542  PRINT  TABXY< I  ,18)i"Enter  the  X-axis  correction  for  point  "ilndex  +  l 

1544  INPUT  Focus< Index.  1  ) 

1546  GOSUB  Ctr_5creen 

1548  PRINT  TABXY( 1  , 1 8  ) ! "Enter  the  Y-axis  correction  for  point  "sindex+t 

1550  INPUT  Focus(Index,2) 

1552  GOSUB  Clr_scr€en 

1554  PRINT  TABXY< I  ,  1 8  ) ; "Enter  the  Z-axis  correction  for  point  "ilndex  +  l 

1556  INPUT  Focus( Index  ,3) 

1558  GOSUB  Clr_screen 

1560  NEXT  Index 

1562  No; OFF  KEY 

1564  OFF  ERROR 

1566  ON  ERROR  GOTO  File_error 

1568  DISP  "" 

1570  RETURN 

1572  I 

1574  I  Cone  here  if  the  set-up  file  doesn’t  exist. 

1576  I 

1578  Input_srror:OFF  ERROR 

1580  SELECT  ERRN 

1582  CASE  32 

1584  BEEP 

1586  CASE  ELSE 

1588  BEEP 

1590  DISP  "INVALID  CHARACTERS  ENTERED;  SYSTEMDATA  —  "&ERRM$ 

1592  ON  KEY  5  LABEL  "PROCEED"  GOTO  GoheadI 

1594  HanQ_here!SOTO  Han9_here 

1596  GoheadI;  OFF  KEY 

1598  END  SELECT 

1600  RETURN 


*  “>  Tit.. 


^  .  Arr  rn)3no 


1610  OISP  "The  set-up  file  doesn’t  ex  1st  on  this  dist'  .  Do  you  want  to  creat 

1612  ON  KEY  S  LABEL  "YES"  GOTO  S6t_oreate 

1614  ON  KEY  6  LABEL  "NO*  GOTO  Oont  .store 

1616  ON  KEY  8  LABEL  "STORE  CURRENT"  GOTO  Storc_.it 

1618  Meit_c("eat€!QOTO  W«lt_create 

1620  Doht_s tores OFF  KEY 

1622  yrite_flag®0 

1624  GOTO  Sys_done 

1626  8et„crsate50FF  KEY 

1628  Write.,flag*3 

1630  GOTO  Sys_done 

1632  Store.itsOFF  KEY 

1634  Write_flag«^2 

1636  CASE  54 

1638  PURGE  "foasetup" 

1640  CASE  55 

1642  BEEP 

1644  DISP  "The  directory  has  overflowed.  Use  a  different  disk." 

1646  ON  KEY  5  LABEL  "READY"  GOTO  Disk„chanqe 

1648  Wait_diskl sGOTO  Walt_disk1 
1650  Dlsk_change:OFF  KEY 
1652  DISP  "" 

1654  CASE  ELSE 

1656  BEEP 

1658  DISP  "SYSTEMDATA  — “&ERRM$ 

1660  Oead_in_h20 SGOTO  Dead_in_h20 
1662  END  SELECT 

1664  Sy6_done:0N  ERROR  GOTO  File_error 

1666  OFF  KEY 

1668  IF  Urite_flag>0  THEN 

1670  IF  Write_flag*3  THEN  GQSUB  Sys.create 

1672  IF  Write_flag»t  THEN 

1674  PURGE  FilenaweS 

1676  END  IF 

1878  CREATE  ASCII  Fi lenane?  .27 

1680  ASSIGN  §Setupfile  TO  Filenaret 

1682  OUTPUT  eSetupfilerVERSION  2.1" 

1684  OUTPUT  @Setupf iiesSerial_nun$ 

1686  OUTPUT  @Setupf i le ?Low_wave ,High_wave 

1688  OUTPUT  ®SetupfilBsLaser(*  ) 

1690  OUTPUT  @SetupfilesFilter_flag 

1692  OUTPUT  eSetupfileiFilter(*> 

1694  OUTPUT  @Setupflle»Num..focus 

1696  OUTPUT  eSetupfilesF  .(*) 

1698  OUTPUT  ©SetupfilesCuioff 

1700  OUTPUT  @Setupf i lesPin_x ,Pin_y ,Pin_s 

1702  OUTPUT  SSetupf lleslnx_6tep ,Iny_step 

1704  OUTPUT  @Setupf i lesOutx_step ,Outy_step 

1706  OUTPUT  iSetupf 1 lesFarf ield_5tep 

1708  OUTPUT  @Setupf 1 ie sLf noise 

1710  OUTPUT  eSetUpfileiDet_5Witch 

1712  ASSIGN  §5etupfile  TO  * 

1714  END  IF 

1716  GOSUB  Clr_screen 

1718  DISP  "" 

1720  Exit: SUBEND 
1722  ! 

1724  I 

1726  SUB  Tinesetl OPTIONAL  Tinedate*) 

1728  !+«*•****#••****#***»*#*♦**»#»#»##»•»*»»»•*•»»*♦»»»« 

1730  !  SET  TIHE/OATE  MODULE  'T-nstOrJ  7  J 


I 

I 

1^ 

I 

I 

I 

( 

I 

I 

I 

[ 

I 


),(a6  unin  iinM  ,rc,D  ,iinn  ,nr  r\  ,1111 1  ,gui4 ,  juu  (injvj  ,  ji_i  ,  ^  -  i  v 

1740  OIH  Honih*<?!t2)t3] 

t742  REAO  HsrtthtC * > 

1744  IF  MPA«*1  THEN 

1745  Hdur**maiM«dat«f ) 

1748  Hlnuti«*VW,<TlH«d«te$tPOS<TiMedatef >+t  j21 ) 

17S0  l1onth«m<Ttnedat«*tP0S(Tlmed8te$,“  ">+li2n  ’ 

1782  Tlwadatat-TlwadatattPOSITlinedatfl* ,“/")+ 1  ,LEN<Tinedate$  )3 

1 754  Day*um.  <  T i weda  t  a  t  > 

1756  Yaar*yALnimadate$lPOS(Tinedate$,"/"  )+l  ,LEN<  TimedateS !  1 ) 

1758  GOTO  S«t_tlMe 

1760  END  IF 

1762  G0SU8  Clr_sfcraen  i Clear  screen 

1764  RetrysPRINT  TABXYl 1  ,16 >? "Please  enter  the  current  time.  Enter  the  hours  and 
Winutefi ,  " 

1766  PRINT  TABXYI 1 , 1 7  )  f “< In  24-hour  format)  separated  by  a  colon.  E;:ample:  I 
3:05" 

1768  BEEP 

1770  INPUT  Hours* 

1772  GOSUB  Clr_8creen 

1774  IF  POS< Hours*," )=0  THEN 

1776  BEEP 

1778  PRINT  TABXYC 1  , 16  ); "Please  enter  the  minutes  (0-59):  " 

1780  INPUT  Minutes* 

1782  HourS=UAL< Hours*) 

1784  Minute6-UAL(Minutes*) 

1 786  ELSE 

1788  ENTER  Hours*  USING  “K  ,K“ jHours .Hinutes 

1790  END  IF 

1792  GOSUB  Clr_screen  i  Clear  screen  ugsm 

1794  6et_month:PRINT  TABXY( 1  , IB  ) j "Please  enter  the  month  as  a  three-letter  abbre 


viat ion. 

II 

1796 

PRINT  TABXY( 1  ,17)i"(JAN. 

PEB,  MAR,  APR,  MAY,  JUN,  JUL ,  AUG,  SEP.  OCT,  NO 

U,  DEO" 

1798 

BEEP 

1800 

INPUT  Mon* 

1802 

FOR  1=1  TO  3 

•Change  lower  case  to  upper  cose  in  month 

1804 

Mon*[Iin=CHR*<BINAND(NUM<t1on*[l5  1  ]  ),BINCMP(32  )  >  ) 

1806 

NEXT  I 

1808 

Month=0 

1810 

FOR  1=1  TO  12 

•LooK  for  the  month  in  month* 

1812 

IF  POS(Mon*,Month*<I)) 

THEN  Month=I 

1814 

NEXT  I 

1816  IF  Month*0  THEN 

1818  BEEP 

1820  PRINT  TABXY(  1  ,l0)rTIME5ET‘ —  You  have  entered  an  invalid  month, 

e  try  again. " 

1822  GOTO  Get_month 

1824  END  IF 

1826  GOSUB  Clr_screen 


1  r-  1828  BEEP 

■  I  V''  1830  PRINT  TABXYd  ,lG)i"Please  enter  the  day  of  the  month  (1-31  ): 

ij  ’  1832  INPUT  Day 


- 1  n 


1834  BEEP 

1836  PRINT  TABXY( 1 ,16  )i "Please  enter  the  last  two  digits  of  the  year: 

1838  INPUT  Year 

1840  Set_timesIF  Month>2  THEN 

1842  Month*Hohth-3 

1844  ELSE 

1846  Month«Month4-g 

1848  Yaar*Y€ar-l 

1850  END  IF 

1852  Year=Year4ig00 


pleas 


I860,  Jultan»Julian»86400+( < 3600*Hours+60*Minute5  )  MOD  86400) 

t86l'  IF  jmia«<2.06SS29l2E+n  OR  JuUafi>«2. 143252224E+1 1  THEN  Rangs_err 

1864  SET  fiHEOATE  Julian 

1868  60T0  Oona 

1868  Range_arr!B6EP 

1870  60SUB  Cln_sere«n 

1872  PRINT  “TIHESET  —  The  tine  or  date  entered  wa$  out  of  range.  Please  try 
agairt." 

1874  SOTO  Retry 

1876  Syntaj?„err:BEEP 
1878  SOSUB  Cl"_screen 

>880  PRINT  TABXYI 1 ,10)t"TIMESET  —  Syntax  error.  Please  try  again." 

1882  SOTO  Retry 

1884  Clr_screen! OUTPUT  K8D  USING  l  Clear  screen  without  scroll 

1 886  RETURN 

1888  Done: OFF  ERROR 
1890  SOSUB  Clr_screen 

1892  DISP  !  Clear  error  messages 

1 894  SUBEND 
1896  I 
1898  ! 

1900  DEF  FNTimedate* 

1902  »+*»**<«**»t*»***#**##»*»****«»#***»»***»»*»#*»**#»«»»*»*»»«»***»*‘»*»*»»*»« 

1904  !  GET  CURRENT  TIME/DATE  MODULE  UERSION  2 1 

I  906  . . . 

1 908  DATA  JAN ,FEB .MAR .APR .MAY .JUN . JUL ,AUG ,SEP  ,DCT  ,N0U  .DEC 
1910  DIM  Month$( l:12)C3] 

1912  READ  Month$( *  ) 

1914  ! 

1916  I  Compute  the  current  hours,  minutes,  and  seconds 
1918  I 

1920  Time_now-INT<TIMEDATE)  MOD  86400 

1922  Hours*Tine_r.ou  DIU  3600 

1924  Minutes~Ttme_now  MOD  3600  DIV  60 

1926  Second5=Time_nou  MOD  60 

1928  I 

1930  !  Find/Compute  the  current  date 

1932  ! 

1934  Julian="iIMEDATE  DIU  86400-1721119 

1936  Year=(4*Julian-l  )  DIU  146097 

1938  Jultan=(4*Julian-1  )  MOD  146097 

1940  Oay=Jullan  DIU  4 

1942  Jullan*'(4*Day+3)  DIU  1461 

1944  Day=(4*Day+3)  MOD  1461 

1946  Day=<Day+4)  DIU  4 

1948  Month=<5*Day-3)  DIU  153 

1950  Day*^(5*Day-3)  MOD  153 

1952  Day-<Day+5)  DIU  5 

1954  Y€ar»< 100*Year+Julian)-1900 

1956  IF  Mont h< 10  THEN 

1358  f1unlh-nunth-i3 

1 960  ELSE 

1962  Month*Month-9 

1964  Yaar=Year+l 

1 966  END  IF 

1968  Timedate0=>UAL*<Oay)&"-"8iMonth$(Month)e,'‘-" 

1970  Year*«=UAL0(Year) 

1972  IF  Year*0  THEN  Y«arS»"0'*&Year* 

1974  Hour sfsUALfl Hours) 

1976  IF  Hours<10  THEN  Hours** "@"&Hours$ 

1978  Mlnutes**UALi< Minutes) 

1980  IF  Minute5<10  THEN  Minutes$=''0"S.Minutes$ 


til® 

f  isa. 

V3S6, 

<398 

2082 

2004 

2006 

2008 

2010 

2012 

2014 

2016 

2018 

2020 


FNENO 

I 

V  [  v. 

SUB  Last t«e< OPTIONAL  Clrflag) 

#••«•*»««  *«•••«•»#-{• 

f  LOG  TINE  AND  DATE  MODULE  UERSION  2.1 

f ••••»«••»««*•»»*»••»•••••»#••••••»•••«•»•»«««•«•«»•»«»»»«#•«»« t *««*»«•»»- 

COM  /FlUar/  Fife«r'_ldt .Fiber  l«fi,Loo_tine* 

IF  NPAB*I  THEN 
Loo_t  inet^f*  *■ 

ELSE 

LaQ_t ine*»FNT iwedateS 
END  IF 
SUBEND 


SUB  Arehive< OPTIONAL  File*) 

t  +**»*•*##***•#***♦»•♦•*•*•#•#*#»***»*****#**»**•**#********♦♦»**»»##*«•+ 

!  ARCHIVE  MEASUREMENT  DATA  MODULE  VERSION  2. IP 

I 

COM  /Diskdrive/  Sysdrlve* .Arcdrive* 

COM  /Fiber/  Flber_ld*  ,‘=^iber_len,Loo_tiMeS 
COM  /Specattdata/  Specattdaia< * ) ,Specatt_idS 

COM  /Dmadata/  Dnarundatal •  )  .Dnaref data( •  )  ,Dmaattendata( » > ,Dma_id$ 

COM  /Farfield/  Ff ieldvall *  )  ,FnuM_points  ,Farf ield< »  )  ,Ff lel d_ld$ 

COM  /Nearfleld/  NfieldvaK *  )  ,Nun_point5  .Naarf leld( »  )  ,Nf ield_id* 


DIM  FilenaMe*CI01,Te«p(25B.I  ) 
INTEGER  Index ,Log_lndex ,LoQ_f lag( 6 ) 


)  Initialize  the  log  data  flags 
I 

FOR  lndex*0  TO  6 
Loo_f l?g< Index  >=0 
NEXT  Index 


•Leave  a  few  extra  spots  for  data 
•  Log  flags  correspond  to  Fiber  test  It's 


..'I  m 
I'l 


•  Compute  the  required  file  sire,  and  set  log  flags 
I 

Nunrec=8  !  Initial  space  for  file  header 

IF  Flber_ld$=Specatt_id$n  ,LEN(Flber_ld$  )]  THEN 
Log„f lag< 1 )=l  •Log  spectral  attenution  data 

Nunrec«'Nunrec+400 
END  IF 

IF  Fiber_id$-Dna_id*C I ,LEN<Fiber_id$)]  THEN 

Log_f iag< 2 )=1  ILog  DMA  data,  200  for  wavelengths, 

Numrec®Nunrec+200+( 200*Dmarundata< 2 ,0  )  >  ! Variable  for  signal  data 

END  IF 

IF  Fiber_idf=Ffield_id$[  I  ,LEN<Fiber_idiB  )  1  THEN 
Log_f lag(3 )*1  ILog  far-fleld  data 

NuMrec»Nur''ec+440  IFibertest  4  data  stored  here  also 

END  IF 

IF  Flber_id$»Nfield_idSC 1 .LEN(Fiber_id$  )]  THEN 
Log_f lag<5 )=1  ILog  near-fleld  data 

Mumrec*Nui»irec+240 
END  IF 
I 

I  If  there’s  no  data  to  write,  don’t  go  any  further,  Just  quit. 

! 

IF  Nunrec»8  THEM 
BEEP 

DISP  "ARCHIVE  —  There  is  no  data  in  memory  with  the  current  fiber  I.D 


i  t  'T 


matt 


Set  the  file  name  froM  the  user  and  open  the  file, 


2124  IF  RPftR>0  THEr4 

2126  Fii«nawe$*Fllei  • 

2125  SOTO  Op«n_file 

2130  ELSE 

2132  SOTO  Set^nane 

2134  END  IF 

2136  Set_rtane!  i 

2138  PRINT  TABXYI 1  ,16  )| "Please  put  the  disk  on  which  the  data  is  to  be  archiv 
ed  in  the  right  hand  drive." 

2140  PRINT  TABXY( 1 , 17 ) I "Then  enter  archive  data  file  name  <10  letters  max). 
Press  PROCEED  when  ready." 

2142  PRINT  TABXYt 1,18)}"  " 

2144  ON  KEY  S  LABEL  "PROCEED*  SOTO  Open_file 

2148  WAIT  2 

2148  INPUT  Filename* 

21S0  Hang_pian:  SOTO  Hang_man 

2152  Open.filesON  ERROR  SOTO  File_err 

2154  CREATE  BOAT  F  t  lenaneMArcdrive*  ,Numrac  ,8 

2156  ASSISN  ©Archive  TO  Fllenanei&Arcdriva* 

2158  OUTPUT  KBD  USINS  "*.K"t"K" 

2160  PRINT  TABXY( 10,1  )jCHR«< 129 )&"  FOA-2000  measurement  data  archive  utility. 

"&CHR*<128) 

2162  PRINT  TABXY< 1  ,3)} "Archiving  data  for  flberJ  ";Fiber_id®i 

2164  OUTPUT  ©Archive iFNTJmedate* 

2166  WAIT  2 

2168  ! 

2170  !  Select  data  to  be  written  from  the  log  flags 

2172  ! 

2174  IF  Loo_flag< 1  )«1  THEN 

2176  OUTPUT  ©ArchiverSPECATTEN" 

2178  OUTPUT  @Archive»Specatt_id$ 

2180  OUTPUT  @Archive<Specattdata< ♦  ) 

2182  END  IF 

2164  IF  Log_flag(2)=t  THEN 

2186  OUTPUT  ©Archive? "DMA" 

2188  OUTPUT  @Arohive?Dma_id$ 

2190  OUTPUT  @Archlve?Dmaattendata{ « ) 

2192  END  IF 

2194  IF  Log_flaQ<3>*l  THEN 

2196  OUTPUT  ©Archive? "FF I ELD" 

2198  OUTPUT  @Archive?Ffield_id* 

2200  OUTPUT  eArchive?Farfield<*  } 


PRINT  TABXY< 1 ,3)? "Archiving  data  for  fiber?  "?Fiber_id®? 

OUTPUT  ©Archive ?FNTJmedata* 

WAIT  2 

Select  data  to  be  written  from  the  log  flags 

IF  Loo_flag< 1  )«1  THEN 
OUTPUT  ©Archive? "SPECATTEN" 

OUTPUT  @Archive?Specatt_id$ 

OUTPUT  @Archive?Specattdata< ♦ ) 

END  IF 

IF  Log_flag(2 )=t  THEN 
OUTPUT  ©Archive? "DMA" 

OUTPUT  @Arohive?Dma_id$ 

OUTPUT  eArchlve?Dmaattendata{ « ) 

END  IF 

IF  Log_flaQ<3>*l  THEN 
OUTPUT  ©Archive? "FFIELD" 

OUTPUT  @Archive?Ffield_id* 

OUTPUT  eArchive?Farfield<*  } 

END  IF 

IF  Log_flag<5)=l  THEN 
OUTPUT  ©Archive? "NFIELD" 

OUTPUT  ©Archlve?Nf leld_lri* 

OUTPUT  @Archlve?NearfiBld<») 

END  IF 

ASSISN  ©Archive  TO  • 

SOTO  Done 


2218  File.err? SELECT  ERRN 
2220  CASE  54 

2222  OISP  "File  "?Filenane*i 
hange  the  name?" 

2224  ON  KEY  5  LABEL  "YES"  SO 

2226  ON  KEY  8  LABEL  "NO"  GOT 

ON  KEY  7  LABEL 


I  Error  54  ==  File  name  already  exists, 
already  exists.  Do  you  want  to  delete  it  or  c 


2228  ON  KEY  7  LABE 
2230  Wait_1 ?SOTO  Walt_t 
2232  CASE  53 


YES"  SOTO  Yes 
NO"  GOTO  Done 
CHANGE"  SOTO  Chng_nm 


n  T  /"*  p  '•  T  , 


2242  CASE  B4 
;2244  BEEP 

224b  DISP  "Thtt  archive  disk  if  full.  Replace  with  a  new  disk.  Initialize  if 
receiaery." 

224S  ON  KEY  B  LABEL  •’PROCEED*  SOTO  New.disk 
2250  «alt_full:60T0  Uait.full 
2252  New_dHk;OFF  KEY 
2254  OISP  •••• 

2256  SOTO  Open_fUe 

2258  CASE  80 

2268  BEEP 

2262  DISP  "The  "&Arcdrlve*8i"  disk  drive  is  enpty.  Please  insert  the  archive 

disk." 

2264  ON  KEY  5  LABEL  "PROCEED"  SOTO  Disk.ready 

2266  Walt_2:60T0  Walt_2 
2268  Olsk_ready:OISP  "" 

2270  OFF  KEY 

2272  GOTO  Open_file 

2274  CASE  ELSE 

2276  DISP  "ARCHIVE  —  HP  Error  Number  "8.0AL*(ERRN ) 

2278  GOTO  Done 

2280  END  SELECT 
2282  Yes  5 OFF  KEY 
2284  DISP 

2286  PURGE  Fl lenameS&ArcdriveS 

2238  GOTO  Open_file 
2290  Chng_nm:OFF  KEY 
2292  OISP  "" 

2294  GOTO  Get_name 

2286  DonesOUTPUT  KBD  USING  i Erase  the  screen 

2298  OISP 

2300’  OFF  KEY 

2302  SUBEND 

2304  t 

2306  ! 

2308  SUB  Retrleve<OPTIONAL  File$/ 

2310  !+»««**#**»»*»#*»»»#«**»#»«»***»»»***»»*»*t‘»******»i‘*f«*«»»**»»*'‘»«»*»*»  + 

2312  I  RETRIEVE  ARCHIVED  MEASUREMENT  DATA  MODULE  VERSION  2.  IP 

2314  !-#♦»###*#•*»*#»*»***»* 


2318  COM  /Diskdrive/  SysdrlveS  .Arcdrlvc* 

2318  COM  /Fiber/  Fiber_ld$ .Fiber_len ,Log_t ime? 

2320  COM  /Specattdata/  Specattdatel •  )  .Specat t_id$ 

2322  COM  /Onadata/  Omarundata( *  )  .Dmaref data( *  )  ,Dmaat tendata( *  )  .Dna._id$ 

2324  COM  /Farfleld/  Ff ieldvaH *  )  ,Fnun_points  ,Farf  leld( *  )  .Ff ic)d_id$ 

2326  COM  /Nearfield/  Nf ieldvaK * > ,Nun_points  ,Nearf ield< *  )  ,Nf ield_id$ 

2328  I 

2330  DIM  Filen3ne*C30] ,Data_type$t70) 

2332  INTEGER  Index, Jindex 

2334  PRINT  CHRS< 121 

2336  ! 

2338  !  Get  the  file  name  from  the  user 

2340  ! 

2342  IF  NPAR>0  THEN 

2344  Fllenamet=Flle$ 

7346  GOTO  Open_f i le 

2348  ELSE 

2350  GOTO  6#t_file 

2352  END  IF 

2354  6et_file!  1 

,2356  PRINT  TABXY( 1 , 16 >i "Please  put  the  disk  containing  the  archived  file  in  t 
he  right-hand  drive." 

2358  PRINT  TABXYt  1  , 17  )i  "Then  enter  the  name  of  the  archived  file.  Pro'^c  PROG 

rrn  i  ec  \  .-nr>h  " 


238SIHan6_Hlt'l !  SOTO  Hang  girl 
2388  I 


2378  6g«n_fll«:0N  ERROR  SOTO  FiU_«rr 

2372  ASSI6N  WrfcHlva  TO  Filenanet&ArcdrivaS  . 

2374  t 

2376  •  Raad  tHa  archive  tina  and  date  from  the  first  line 

2378  «  of  the  file. 

2380  f 

2382  ENTER  «ArchiveiArchive_date* 

23e»  OUTPUT  KBD  USIN6  lErase  screen 

2388  PRINT  TABXY< 1 ,5 )t "Retrieving  data  archived  ons  " (Archl ve_date$ 

2388  PRINT  TABXYn ,7  )i “This  archive  file  contains  the  following  data:" 
2390  PRINT 

2392  I 

2394  I  Read  the  data  type  header,,  If  it’s  SPECATTEN,  read  the 
2398  I  following  array  into  Specattdata< *  ).  If  not,  check  the 
2398  )  other  data  types. 

2400  I 

2402  ENTER  §ArchiveiData_typet 

2404  IF  Data_type*«"SPECATTEN“  THEN 

2408  ENTER  @ArchlveiSpecatt_id* 

2408  ENTER  0ArchIvBiSpeeattdata< *  ) 

2410  PRINT  "Spectral  Attenuation  Data" 

2412  PRINT  "  for  fiber;  " iSpecatt_id« 

2414  ENTER  0ArchivejData_type* 

2418  END  IF 

2418  I  Read  DHA  data  (if  any). 

2420  IF  Oata_type$*"DMA"  THEN 

2422  ENTER  @Archive »0na_idS 

2424  ENTER  ftArchive iDnaattendata( •  ) 

2428  PRINT  "Differential  Modal  Attenuation  Data" 

2428  PRINT  "  for  fiber:  "iDna^ld* 

2430  ENTER  @Archive;Oata_typeS 

2432  END  IF 

2434  I  Read  Far-field  data  (if  any). 

2436  IF  Data_type*="FFIELO“  THEN 

2438  ENTER  @Archi ve »Ff ield_id$ 

2440  ENTER  «Archive»Farf Ield( *  ) 

2442  PRINT  "Far-field  data" 

2444  PRINT  "  for  fiber:  ":Ffield_ld* 

2446  ENTER  ©Archive jData_type* 

2448  END  IF 

2450  !  Read  Near-field  data  (if  any), 

2452  IF  Data_type$*“NFIELD"  THEN 

2454  ENTER  ©ArchiveiNf ield_id* 

2458  ENTER  ©ArchiveiNearf ield( *  ) 

2458  PRINT  "Near  field  data" 

2480  PRINT  "  for  fiber:  "iNfield_id$ 

2462  ENTER  ©Archive »Data_type* 

2464  END  IF 

2466  ! 


lie 


2472  File_err;IF  ERRN»59  THEN 


2474 

2476 

2478 

2480 

2482 

2484 

2486 

2488 


•Error  S9“End  of  file  reached. 
•Close  the  file 
•We’re  done. 


ASSIGN  ©Archive  TO  * 

GOTO  Done 
END  IF 

IF  ERRN*89  THEN 

OISP  "No  disk  in  right  hand  drive,  please  insert  and  try  agoin 
GOTO  6ei_flle 
END  IF 

IF  ERRN=53  THEN 

ntCD  “rjtrt  r'Tnn  iinr /*-  i  I  ^  h.ir  .1 "  ” 


*.488  OISP  "The  archive  file  <"|FllenaMe*?  ">  isn’t  on  this  disl 
to  try  aoain?" 

2500  OM  KEY  5  LABEL  "  YES"  BOTO  Yes 

2502  ON  KEY  6  LABEL  "  NO"  GOTO  Quit 

250#  ««l inheres GOTO  «eit_h«r« 

2506  Yet:  ! 

2508  OFF  KEY 

2510  OUTPUT  KBO  USING  "f  .K"»"K"  ! Erase  screen 

2512  CAT  Arcdrive* 

2514  GOTO  6et_flle 

25 15  END  IF 

2518  OISP  "RETRIEUE  —  HP  Error  Number  "8,UAL$<ERRN ) 

2520  ON  KEY  5  LABEL  "RETURN*  GOTO  Unspeced 

2522  Oead_ifi_h20!GOTO  Dead_in_h20 

2524  Unipcced:  OFF  KEY 

2526  CALL  Cleardisplay 

2528  SOTO  Set_flle 

2530  Done! IF  NPAR>0  THEN  GOTO  Quit 

2532  ON  KEY  5  LABEL  "CONTINUE"  SOTO  Quit 

2534  Wait_done:GOTO  Wait.done 

2535  Quit!OUTPUT  KBO  USING  "#,K“rK" 

2538  OISP 

2540  OFF  KEY 

2542  SUBENO 


Do  you  went 


SUB  Zcenter 


2552  I  Z-AXIS  MOTOR  CENTERING  MODULE 


UERSION  2.! 


!  ***•  NOTE  **♦* 

!  The  FOA-2000  commands  used  in  this  module  are  not  documented  in 
!  the  FOA-2000  manual  and  should  be  used  only  under  direction  of 
!  Photon  Kinetics. 

! 

CALL  F2000send<  "ALIGN  INZ  COUPL  3000  DARK"  ,1  )iFind  edge  of  INZ  senrsor 
CALL  F2000send< "INZ  ZER  -900  GOTO  INZ  ZER"  ,  I  > iBacl.up  and  stop 
CALL  F20005end(  "OUTZ  COUPL  3000  DARK",1  )  !Find  edge  of  out."  sensor 
CALL  F20006end< "OUTZ  ZER  -900  GOTO  OUTZ  ZER"  ,1  ) 'Baci up  and  stop 
SUBEND 


SUB  Rundisplayi Message* ) 

!  IN  PROCESS  DISPLAY  MODULE  •  UERSION  2.1 

6INIT 
GGLEAR 
GRAPHICS  ON 

Mn*  le  ft  Oft 

t  IW  VI.  y  »J%J 

CSIZE  5, .57 
LABEL  Message* 

SUBEND 


SUB  Cleardisplay 

1  CLEARDISPLAY  -  clears  both  alpha  and  graphics 

OFF  KEY  IClears  labels  from  bottom  of  screen 

DISP  "  "  IClears  header 

DllfPHT  KRD  IIPINR  "#  iCtpar';  n  I  nliamimrr  ( .'■  - 'i  k-,- '■  ( '’r  ' 


^  yait^flao) 

''•2632-?  ••«•»««•»•»*»»»* •«»««»» 

:p3f  r  TO  FOA-^2000  HOOULE  UERSION  2 .  IP 

VpSsr  •.».*•••,•*#••*#*••**#*••*•***••**•**»♦#*»*»♦»#*«****»**» **#♦♦»♦»*# 

^630  COH-  /topitHi/'  @Foa2080 ,§E0Q5205,®Tek78S4  ,@Bncdelay ,Printer_add 
2840  COM  /PpliVious/  Pmviou**  !A  place  to  remember  the  last  command 

2642  OIH  HessagettSe] 

2S44  iNTESER  Statbyt  .Bueybit 

2846  INTE6ER  Posn 

2648  8u5yblt»4 

26S0  nessaget-MessS 

2652  DISP  "FOA-2000S  "jMeaBagat  IDisplay  the  message  we’re  sending 

2654  8usy!Statbyi*SPOLL<0Foa2000 )  iQo  a  serial  poll  on  FOA2000 

2656  IF  BIT<Statbyt,Bu8yblt)«»  THEN  GOTO  Busy  !If  busy,  poll  it  again 

2858  60SUB  Err_ehk  !Any  errors? 

IF  Erp_flag  THEN  DISP  ’'FOA-2000S  "jMessageS  !If  so,  re-display 

OUTPUT  ®Foa2000  USING  "K* iHessageS  IReady,  so  send  message 


•Integers  make  better  status  bytes 
!  Used  to  looae  "LOW"  in  Messages 


2660 

2682 

2864 

2688 

2668 


PreylouB®*Hes8agaS 
IF  NPAR-1  THEN  Done 
IF  Uatt_fiag*0  THEN  Done 


2870  Not_done!WAIT  .1 


IRemember  last  cmd.  in  case  of  error 
•If  ualt^flag  not  specified,  don't  wait 
fif  uait_fiag=0,  don’t  wait. 

IGive  FOA2000  a  chance  to  assert  busy 


2672 

2874 

2676 

2878 

2680 


Statbyt«SPOLL( 0Foa2000 ) 
SOSUB  Err  ohk 


! Check  for  errors 


IF  BITlStatbyt  .Busyblt  )=l  THEN  GOTO  Not_done 


60SU8  Err.chk 
SOTO  Done 


•Check  for  errors 


2GB2  Err_chk:Err_f iag»0 


•Clear  the  error  flag 


2684 

2686 

2688 

2690 

2892 

iousS 


IF  Statbyt>9B  AND  Stathyt<l 00 -THEN 
Err_f  lag**! 

BEEP 

IF  Statbyt»99  THEN 


!6ot  an  error,  set  the  flag 


PRINT  TABXY( t  ,15)»“FOA-2000  ERROR  NUMBER:  "&UAL$( Statbyt >i"  "&Prev 


2694  PRINT  TABXY( 1  , 16  )» "Motor  error.  Probably  caused  by  fiber  misalignm 

ent  or  a  bad  fiber  end." 

2696  PRINT  TABXY( 1  , 1 7 ) i "First  try  focussing  the  fiber  end  on  the  screen, 

and  press  PROCEED." 

2698  CALL  F20008end< "ALIGN"  ) 

2700  ELSE 

2702  PRINT  TABXY(  I  ,}5>»"FOA-2000  ERROR  NUMBER:  "&UAL*<  Stutbyt  >S "  "S,Prev 

ious$ 

2704  END  IF 

270G  LOCAL  eFoa2000  'Put  the  foa2000  in  local  mode 

2708  ON  KEY  5  LABEL  "PROCEED"  GOTO  Proceed 

2710  Wai  i;_here:60T0  W3it_here 

2712  ProceedsDISP  "FOA2O00:  "tPrevlous*  IDisplay  the  command 

2714  OUTPUT  9ro82000  USING  "K" jPreviousS 

271G  WAIT  .01  !  •#  TEMPORARY— Give  the  foa2000  time  to  get  busy  ♦♦  • 

271 8  Busyl !Statbyt®SPOLL(@Foa2000 )  {Serial  poll  the  instrument 

2720  IF  BITlStatbyt  .Busyblt  )=1  THEN  Busy!  IKccp  trying  till  not  busy 

2722  GOTO  Err_chk  • Check  for  errors  once  more 

2724  END  IF 

2726  RETURN 

2728  Done; DISP  *  " 

2730  SU8EN0 
2732  •  - 

2,704  ! 

2736  SUB  Preset 

2738  !♦^^i»»•*M^^^l**#»ft•*•»♦»^^*^^*i'*•«•*****•*•#*♦*t*•**#**  »»«***•»»»»»»  »»»»♦*•♦  + 

2740'  !  system  PREfET  NOPULE  VERSION  2. fP 

2742  t  #*««•••••  «  >«  » ■>  v*  »  >  « 


pytPUT  KBO  USING  "t  .K” » "K"  !  Clear  alpha,  screen 

S^S2;  CAUL  RiirtdiSplijyt  *  Initialising  system  equipment.") 

2IM:  CALL  F200«««nd<  "3.  ATTENUAT  CHOP-ON  LAMP-ON  LED-ON.'  GERMAIN"  ) 

Ifsfe  ’  , 

2:7S0r  j  Center  the  FdA-2000  focus  motors. 

2760  f 

27f2  PRINT  TABXYd  JSirCentering  the  FOA-2000  focus  motors." 

2784  CALL  Zcenter 
27BS  I 

2788  t  Now  wait  for  the  operator  to  confirm  warm-up 
'2770  I 
2772  BEEP 

2774  PRINT  TABXY< 1 , IS >! "Please  check  that  all  equipment  is  ON.  The  FOA-2000  m 
ust  be  al lowed  to  warm" 

2776  PRINT  TABXY< t  , 17 )i “up  for  5  minutes  before  proceeding.  Press  the  PROCEE 
D  key  <f5)  when  ready." 

2778  ON  KEY  5  LABEL  "PROCEED"  GOTO  Proceed 

2780  Here:SOTO  Here  IWait  for  them  to  press  the  key 

2782  Proceed: OFF  KEY 

2784  OUTPUT  KBO  USING  "#,K"5"K" 


2788  CALL  F20008end( "LED  LED-ON  ILLUMIN  UOUT  TARGET-OUT  SPOT-OUT  FF-OUT  3  ATT 
ENUAT"  ,1  ) 


2792  !  Check  chopper  operation  by  looking  at  reference  status  on  EGG 

2794  ! 

2798  Eggstatu8»SPOLL<0EggS205) 

2798  IF  BITIEggstatus.S)*)  THEN 

2800  Retry:OUTPUT  KBD  USING  "#,K"}"K"  'Clean  up  screen  from  error 

2802  OFF  KEY 

2804  PRINT  TABXY( t  ,16)1 "Waiting  for  the  FOA-2000  chopper  to  stabilise." 
2806  CALL  F20006end< "CHOP-OFF  CHOP-ON"  ,1  ) 

2308  Starttime»TIMEDATE 

2810  Wait_loop:WAIT  2 

2812  Eggstatus»SPOLL<@Egg5205) 

2814  IF  BIT(Eggstatus  ,3)=0  THEN  GOTO  Chop_ready 

2816  IF  TIMEDATE-Starttime>30  THEN 

2818  BEEP 

2820  DISP  "The  FOA-2000  Chopper  is  inoper.Tt  i  ve  ,  or  the  locl-in  .implifier 

reference  channel  is  disconnected." 

2822  ON  KEY  5  LABEL  "  Retry"  GOTO  Retry 

2824  ON  KEY  6  LABEL  "  Stop"  GOTO  Quit 

2326  Mait_key:GOTO  Walt_key 

2828  Quit:  OFF  KEY 

2830  Deadt :  GOTO  Oeadi 

2832  END  IF 

2834  GOTO  Walt_loop 

2836  Chop_ready .'WAIT  10  '  Wait  10  more  seconds 

2838  END  IF  ISkio  the  whole  thina  if  REF  LOW  bit  is  not  set 

2840  I 

2342  I  Initialize  EGG  5205/7  settings  t ,  sending  selected  device  clear  (SDC). 
2844  I 

2846  PRINT  TABXY< 1  ,16 >, "Setting  up  the  EGG5207  Lock-in  Uoltmeter." 

2848  CLEAR  iEgg52@S 
2850  1 

2852  1  Set  the  E665207  phase  (twice,  for  assured  precision) 

2854  ! 

2858  CALL  E520Scomm< "AZ  1 " ) 

2858  Call  EBZeScommC *A2  1") 

2860  ! 

2862  1  Set  the  EG6S207  to  a  known  range 


r  rsywuuu  uay  \  ^  - 

2872  PRINT  TABXY( 1  .17 )  ."In  this  case,  BE  SURE  THAT  THE  LAHP  IS  TURNED  ON  befo 
re  RroceeBiriQ. * 

2874  PRINT  TA8XY< I , 18 ) , "To  skip  this  step,  press  the  SKIP  key  (fS)." 

2876  ON  KEY  S  LABEL  "PROCEED"  GOTO  Mono_cal 

2878  ON  KEY  1  LABEL  "  SKIP"  GOTO  Skipped 

2880  HatiQ_Out !  GOTO  Hang_out 
2882  I 

2884  Hono.cal!  OFF  KEY 

2886  OUTPUT  KBO  USING  "#,K"t"H“ 

2888  CALL  F20005end< "0  ATTENUAT"  ,1  ) 

2890  IF  Fllter_flag=1  THEN  GOTO  Done 

2892  CALL  F20008end< "0  FILTER  LAMP  SOURCES  1T01  0SEEK  WAU  COUPL",!) 

2894  LOCAL  §Foa2000 

289G  PRINT  TABXY( 1  , IS >» "Please  adjust  the  nonochronator  wavelength  for  the  ze 
ro-point  calibration  (light" 

2898  PRINT  TABXY< 1  , 1 7  )  j "centered  on  the  launch  spot,  approaching  it  using  a  c 
lockuise  knob  rotation)." 

2900  BEEP 

2902  ON  KEY  5  LABEL  "PROCEED"  GOTO  Wave_cal 

2904  Wait3;G0T0  Walt3 

2906  Wave_cal;  CALL  F2000send( "WAUE0"  ) 

2908  !  CALL  F2000send( "UAUE0" ) 

2910  1 

2912  Skipped:  OFF  KEY 

2914  !  IF  AligntnenK  0  )=0  THEN  CALL  Fibertype  'Query  for  fibertype 
2916  Done:OUTPUT  KBO  USING  “#,K"t“K" 

2918  CALL  F2000send< "ALIGN"  ,  1  )  ILeave  the  system  m  alignment  set  up 

2920  LOCAL  0Foa2000  lAlso  leave  the  control  panel  in  local  mode 

2922  CALL  Cleardisplay 
2924  SUBEND 

2926  ! 

2923  ! 

2930  SUB  E5205comn( Message*  .OPTIONAL  Ualue) 

2932  l+*#***»#*#*»«»*»tt*»**«*i***«***4*»****»«****»*«»*«»»*****«»#»*#»*»»»****+ 

2934  !  EGGB205  COMMUNICATION  MODULE  UERSION  2. IP 

2936  |-**»*»*****»#***#**tf»##**««*###»»»**»*»**»*»**»«»*»***»f »♦*»«« »»»»*»♦♦•- 

2938  COM  /lopaths/  @Foa2000 ,@Egg5205 ,@Tek7854  ,@8ncdelay  ,Printer_add 

2940  INTEGER  Eggstatus 

2942  DISP  "EGG5205:  "^Message* 

2944  Start=TIMEDATE 

294B  ! 

2948  I  Send  the  command  or  query  to  th2  5205 
2950  I 

2952  Bu5y:G0SU8  Poll.egg  'Serial  poll  the  ESG5205 

2954  IF  T1ME0ATE-Start>5  THEN  GOTO  Timout  (Report  timeout 

2956  IF  NOT  8IT( Eggstatus  ,0 >  THEN  GOTO  Busy 

2958  OUTPUT  eEgg520S  USING  "K" {Message*  'It’s  ready,  send  message 

2960  ! 

2967  t  Take  in  a  resoonse  from  the  5205  if  one  is  indicated;  Wait  for 

2964  I  "command  complete"  and  "settled"  before  returning. 

2966  ! 

2968  Wait_done;GOSUB  Poll.egg 

2970  IF  BITCEggstatus,?)  THEN  ENTER  @Egg5205{Ualue1 

2972  IF  NPAR>1  THEN 

2974  Ualue®Valuel 

2976  END  IF 

2978  IF  BINANO(Eggstatus,33)<>33  THEN  GOTO  Wait.done 

2980  DISP  "  " 

2982  GOTO  Done 

2984  Poll_egg:MAIT  .01 
2986  EQgstatu8=SPOLL(@Egg520S) 


'Serial  poll 


'.t.a;aa  Uii  t\c.i  o  i_nu>Li_  aiur  juiu 

tat.! SOTO  Wait  1 
f3|0i.Prbei«d  ;OFF:  KEY 
3@l2-:  Start«TI«EOATE 

3004  SOTO  Busy 

3000  Quits OFF  KEY 

Mb  stop 

3010  DUisasSUBEWD 
3012  I 

3014  I 

3016  OEF  FNOo It wetp* < Accuracy) 

3018  {4#####«*****/  >»««««««««««*«*«««««««»»««««»«»«*«««»«*«««,««««##«#«»»««»««^  1 

3020  I  EGS5205  UOl  ' »  ,E  READING  MODULE  UERSION  2.1  | 

3022  !-***•**  t^****************^******#**********  »•»•#»»««»««*«•«•«»»»•««.«««»#»•_  I 

3024  COM  /Ebq520B/  Scales< *)  .Settle .INTEGER  Nun_aver .Range  I 

3026  COM  /Syscal/  Pin_>?  ,Pin_y  ,Pin^2  .Inx_6tep  ,Iny_step  ,0ut>s_step  ,Quty_step  .Far  I 

f ieid_8tep  .Nolselevel  ■  | 

3028  COM  /Icpaths/  eFoa2000 .eEoQ5205 .©TelUSSp .@Tek78B4 ,Printer_add  \ 

3030  DIM  01dr«adtng(31  )  I 

3032  INTEGER  Index , I  ,Oeun_ccunt ,Nuw_readings  .Referlow  .Overload  | 

3034  I  I 

3036  Lc!west_ran9e»»12  iLouest  allowed  EGGB20B  scale  =500uv  | 

3038  !  I 

3040  IF  Accuracy<>0  THEN  I  Make  sure  we  know  the  5205  range  i 

3042  CALL  ES20Bconn( “S"  .Rangeread )  | 

3044  Range*lNT(Rangeread)  I 

3046  END  IF  | 

3048  t  I 


3050  !  If  Accuracy=0 ,  the  nunber  of  averages  and  range  should  not  be  ari.iusted.  I 
3052  !  If  Accuracy<>0.  compute  the  number  of  averages  required  to  achieve  the  s 
30S4  I  requested  accuracy.  Accuracy  is  expressed  in  dB.  Use  TEMP  to  avoid  ; 
3056  I  INTEGER  overflow. 

3058  f  * 


3060  Restart: IF  AccuracyOO  THEN 


3062 

Perror® . 23*Accuracy 

! Convert  dB  to  X  error 

3064 

T  emp®( No i se 1 eve 1 / <  Perror *400*Sc 

alestRange ) )  )''2 

3065 

IF  Temp<e  THEN  Tenp='6 

IMinimum  4  of  averages 

=  B 

3068 

IF  Temp>30  THEN  Temp=30 

! Maximum  4  of  averages 

®  30 

3070 

Num_aver®Temp 

3072 

Scttle=Perror*400»Scale5(Range ) 

•Settling  requirement 

3074 

END  IF 

3076 

Sum*0 

•Inl'^lalizc  the  running  sum 

3078 

Sun_6quares=0 

•And  the  sum  of  the  squares 

3080 

Num_reading6=0 

•Initialire  the  readings  counter 

3082 

FOR  lndex*0  TO  Num_aver 

•Set  the  oldreadings  array  " 

^  0  . 

3084 

Oldreadingi  Index  )®0 

3086 

NEXT  Index 

» 

3088 

lndex*0 

!And  initialise  oldreadings 

inde 

3090 

Res_limit®Soales(Range ) 

•Resolution  limit  Is  1  LSB 

3092 

! 

3084  !  Get  a  voltage  reading 

3098  1 

3038  Ti*TIMEOATE 

3100  Acquire*.605UB  PoUegg 

3102  IF  Referlow  THEN 

3104  BEEP 

3106  biSP  "UOLTHETER  --  EGG  5205  Reference  level 

3108  ON  KEY  S  LABEL  "PROCEED”  GOTO  Reref start 

3110  WaltTtSbTO  Wait? 

3112  Reref start sOFF  KEY 
3114  GOTO  Reetart 


too  low." 


t  %  iw  ^  iw  ^  V^\jr  W  (  (  *  *  « 


•  '  a 


3128 

3130  ■ 

3132 

3134 

3138 

3138 

3140 

3142 

3144 

3148 

3148 

3150 

3152 

3154 

3156 

3158 

3180 

3182 

3164 

3168 

3168 

3170 

3172 

3174 

3176 

3178 

3180 

3182 

3184 

3188 

3188 

3190 

3192 

3194 

3196 

3198 

5  THEN 

3200 

3202 

3204 

3206 

3208 

3210 

3212 

3214 

3216 

3218 

3220 

3222 


IF  Accuracy<>0  THEM  (DON’T  down  range, if  aocuracy^O 

IF  ABSIReadlng  )<400  AND  Rang€<Lowest_rangQ  THEN 
60SUB  0&Un_ranga 

GOTO  Rastart  I  Start  over  on  averages 

END  IF 
END  IF 

IF  ABSIReading )>2000  THEN  !We  can  always  try  to  up-range 
GOSUB  Up_reng6 

GOTO  Restart  I  Start  over  on  averages 

END  IF 

I 

I  This  reading  is  within  the  range  limits,  so  scale  it  into  volts 
!  before  adding  it  to  the  running  sun  and  computing  standard 
I  deviation. 

I 

Reading*Reading*Sca}e5(Range ) 

! 

!  A  running  sun  and  sum  of  squares  is  kept  of  the  number  of  most 
I  current  readings  specified  by  nun_aver.  Each  time  a  new  reading 
I  is  added  to  the  running  sun  the  oldest  reading  is  removed  from 
!  the  sun  so  that  the  sun  always  reflects  the  most  current  readings. 

I 

Sun*Sun+Raading-01dreading( Index )  (Update  the  sums 

Sun_square8=Sun_squares+(  Reading '2  )-01dreading(  Index  )''2 
Oldreadingf Index  )=Reading  IReplace  old  reading  with  new  one 

Index=( Index+1  )  MOD  Nun_aver  (And  update  oldreadings  Index 

Nun_reading8®Num_readlngs+1  .  ICount  the  new  reading 

I 

!  If  we  have  acquired  at  least  nun_aver  readings,  compute  the  standard 
1  deviation  of  the  last  riun_aver  readings  and  compare  it  to  the  noise 
!  Unit  and  resolution  limit.  If  the  result  is  inside  these  limits, 

I  the  E665205  has  settled,  so  return  the  average  of  the  readings. 

! 

IF  Num_readings>=Nun_aver  THEN  !If  acquired  enough,  check  noise 

Nolse*S0R<  ABS<  Sum_square6-(  Sum  )''2/Num_aver  )/Num_aver  ) 

IF  Noise<Noi6elevel  OR  Noise<Re6_limit  OR  Noise<Settle  OR  TIMEDATE-T1> 


Result*Sum/Num_aver 
GOTO  Done 
END  IF 
END  IF 

GOTO  Acquire 


1 


•If  noise  is  within  limits,  return 
I  the  average  of  the  readings. 


•If  not  enough  averages  or  too  much 
Incise,  go  get  another  reading 


•  Poll  the  EGG5205  and  break  its  status  down  into  2  conditions: 
I  Reference  low  and  Overload  These  conditions  are  returned  to 
!  as  separate  variables  with  a  value  of  1  if  the  condition  is 
!  true  or  0  if  it  is  false. 

I 


3224  Pol legg:Eggstatus*SPOLL< @Egg5205 ) 

3228  Referiou=Bil<Egg6tatus,3? 

3228  Ovarload=BIT<Eggstatus ,4) 

3230  RETURN 

3232  1 

3234  I  This  subroutine  increments  the  EG65205  range  when  the  reading  is 
3236  I  greater  than  2000  or  when  overload  status  occurs. 

3238  I 

3240  Up_ran§e!lF  Range*0  THEN  (We're  already  at  highest  range 

3242  BEEP 

3244  OISP  -yOLTMETER  —  E66S20S  is  overrange  on  highest  range." 

3246  ON  KEY  5  LABEL  "PROCEED*  SOTO  Reoverstart 

3248  Waits: GOTO  Waite 


-''rn  t7„„  .  -I-,.  I-,  nrr  I'rv 


I  V.  I.* 


W  L.  sjt) 

32S8 

3250 

3262 

3264 

3266 

3268 

3270 

3272 

3274 

3276 

3278 

3280 


ir  nu;-ut  -u  I  lii_n 

Ranae®Ratige- 1 
ELSE 

END  IF 

IF  Range <0  THEN  Rangs-0 

CALL  ES20Scomm< "S  " &VALS< Range ) ) 

WAIT  1 

RETURN 


!<only  I  step  if  no  steps  bed' 
!  allowed) 


•Set  the  E86  to  the  new  range 
!  Tine  for  EGGS205  transient 


! 

f  This  subroutine  decrenents  the  EGG520S  sensitivity  to  achieve  readings 
!  greater  than  400. 
f 


3282  Down_range!Umagnitude-A8S< Reading*Scales( Range ) ) 

3284  FOR  1*1  TO  5  iMax  allowed  range  change*5  steps 

3286  RanQe*Range+1 

3288  IF  t/wagnitude>400*Scales(Rang'« )  THEN  Set_down 


3290  NEXT  I 


3292  S6t_down!lF  Range>Louest_range  THEN  Range*Louest_range 
3294  CALL  E5205comm( "S  "SUALSi Range  ) ) 

3296  WAIT  I  ! Allow  recovery  tine 

3298  RETURN 

3300  ! 

3302  !  Return  the  average  of  the  readings  to  the  caller 

3304  ! 

3306  Done:RETURN  Result 
3308  FNENO 
3310  I 

3312  1 

3314  SUB  Setscalel Accuracy  .Maxvolts  ) 

3316  !+**♦*«#♦#«*•**»*»♦•***♦♦♦*»*»**»*»*♦*•*»«*♦*•»•*•*****#*»«♦»»*»»♦♦»»»»»*+ 

3313  1  SET  E665205  RANGE  MODULE  UERSION  2.1 

3320  I -»»»♦**•*»»•»*#*#••♦»#*»•»»••♦»»♦»»»♦»»♦♦»•»»»♦♦♦.»*■«»»»»*«»»**»>«♦»»»♦»- 


3322  COM  /Egg5205/  5cales< •) .Settle .INTEGER  Nun_avcr .Range 

3324  COM  /Syscal/  Pin_x .Pin_y .Pin_z .Inx_step .Iny_step  .0utx_5tep ,0uty_5tep  .Far 
f ield_step .Noiselevel 

3326  FOR  Index*14  TO  0  STEP  -1  !  Figure  out  the  appropriate  range 

3328  IF  Scalesi Index  )*2000>*Maxvolts  THEN  GOTO  Set_range 

3330  NEXT  Index 

3332  lndex=0 

3334  BEEP  IMaxvolts  is  too  big' 

3336  PRINT  TABXYt 1  , 1 7 )j "SETSCALE  --  The  maxinuM  voltage  specified  for" 

3338  PRINT  TABXY< 1 ,18  )j "the  EGG  5205  is  too  large." 

3340  Dead  1; GOTO  Oeadl 


3342  Set_range:Range*Index  'Set  the  range 

3344  CALL  E5205conin<  "5  "&UAL*<  Range  ) ) 

3346  Perror*.23*Accuracy  'Convert  dB  to  X  error 

3348  Nun_avar*<Nolselevel/<Perror»4O0»Soales(Range  ) )  >'‘2 
3350  IF  Nun_aver<6  THEN  NuM_aver=6  iMinimun  4  of  averages  =  6 

3352  IF  NuM_aver>30  THEN  Nupi_aver=30  IMaxinuw  It  of  averages  =  30 

3354  Settle*Perror»400*Scales(Range)  'Settling  requirenent 


335b 

3358 

3360 

3362 

3364 

3366 

3368 

3370 

3372 

3374 

3376 

3378 


SUBEND 

I 


SUB  Arraybuildt InstringS ,0utarray( • ) .Arraylen ) 


f  ARRAY  BUILDER  MODULE  'VERSION  2.1 


For_f 188*0 
Array leh*0 
Step_val=l 
Tenpf*" " 

ON  ERROR  GOTO  Errorline 


•Set  for  loop  flag  *  0 
•Set  initial  array  length  *  0 
•Set  default  step  index  value 
Unitialize  temporary  string 


-  •  A r  '-v 'A  r  .  I  m  »  •  Tn  t  f* ‘ '  f  , ,  .  t  ' ,  t*  \ 


I  r  1 


o  jaw 

3^88 

3390 

3392 

"TO" 

3394 

3396 

3398 

3400 

3402 

3404 

3406 

3408 

3410 

? 

3412 

3414 

3416 

3418 

3420 

3422 

3424 

3426 

3428 

3430 

3432 

EN 

3434 

3436 

3438 

3440 

3442 

3444 

3446 

3448 

3450 

3452 

3454 

3456 

3458 

3460 

3462 

3464 

3466 

3468 

3470 

3472 

3474 

3476 

3478 

3480 

3482 

3484 

3486 

3488 

3490 

3492 

3494 

3496 

3498 

3500 

3502 

3504 


I 

IF  Ind«H<LEN< Instring$ )-l  THEN  IDon’t  look  if  near  the  end 

IF  In«trlha*CIndexi2]»"t<3“  OR  InstringSC Index ?2 ]="T0"  THEN  ILook  for 

60SUB  For_loop  IFound  a  "TO" — go  process  it 

SOTO  NeU_val 
END  IF 
END  IF 

1 

1  Check  fdr  “STEP"  keyword 
I 

IF  Index<LEN( InstringS >-3  THEN  IDon't  look  if  near  the  end 

IF  In8tring$tlnde>t|4]«"step"  OR  InstringSI Indexj4]=”STEP"  THEN  ISTEP 

60SUB  Step_loop  ! Process  the  STEP 

GOTO  Next_char 
END  IF 
END  IF 
I 

1  If  the  next  character  is  not  a  nuMber ,  decimal  point  ( ,  )  or  minus  sign, 

!  it  is  a  separator  character,  so  figure  out  what  to  do  about  it.  If  the 
!  next  character  is  a  number,  .  or  Just  add  it  to  the  tempi. 

! 

Oalue=NUM( Instring$[ Index » 1 ]  )  'Get  the  next  char's  value 

IF  (Ualue<48  OR  Value>57)  AND  Ualue<:>32  AND  Ualue<>4B  AND  Ualue':;’45  TH 


I 

!  First,  check  to  see  if  we  have  a  FOR  loop  in  process. 


Neu_val ! SELECT  For_flag 
CASE  1 

60SUB  Load_5tart 
GOTO  Next_char 
CASE  2 

GOSUB  Load_end 
GOTO  Next_char 
CASE  3 

GOSUB  Run_loop 
GOTO  Next_char 
END  SELECT 

Outarray<  Arraylen )=UAL<  Tempi  ) 
Array  1 en=Arr ay  1 en+ 1 
Temp$="" 

END  IF 

Next_char ‘.NEXT  Index 
1 


IWe’ve  passed  a  "TO" 

•Go  load  the  starting  index 
'And  keep  looking 
'.This  is  the  ending  value 
'Load  ending  index  and  run  loop 

!A  FOR  loop  with  STEP  value 

'Run  the  loop 

'And  start  checking  again 

•No  FOR  loop  is  in  progr-er.s 

'It’s  just  a  regular  value 

! Increment  the  array  length 

'And  clear  the  temporary  string 

'Check  the  next  input  character 

INSTRlNGi,  check  to  see  if 
it’s  just  a  regular  value 


'  Uhen  we  run  out  of  characters  in 
I  we  have  a  FOR  loop  pending,  or  if 


SELECT  For_fiag 
CASE  1 

Goto  Syntax_arr 
CASE  2 

GOSUB  Load_end 
GOTO  Done 
CASE  3 

SOSUB  Run_loop 
GOTO  Done 
END  SELECT 

OutarrayfArraylen JsUAL(Tenp$ ) 
ArraylBn*ArrayIefi-k  1 
Goto  Done 


'A  "TO"  with  no  ending  value 
! That’ 5  a  syntax  error 
I A  FOR  loop  ending  with  no  STEP 
'That’s  OK,  go  run  the  loop 

!A  FOR  loop  with  a  STEP  value 
ILoad  the  STEP  and  run  the  loop 


fit's  Just  a  last  regular  value 
! Increment  array  length 
! And  nui  t 


I 

I 

I 

I 

I 

* 

[ 

[ 

i 

I 

[ 


I 

I 


Wvi  i 

1  U(%ii 

} 

3514 

Step_ldop:IF  For_flag<>2  THEN  Synta>?_err 

ISTEP  isn’ t,  al lowed  before  tO 

i 

1 

35  Is 

EHd^tnd«>^aUAL<  Tflrtpf  1 

ILoad  the  epding  index 

1 

3 

3Si8 

Inde5<*Index+3 

•  Point  past.,  the  "STEP"  keyword 

} 

3520 

FQr_flaQ=3 

! ready  for  .the  STEP  value 

i 

i 

3522 

TewpSa"" 

1 

3524 

RETURN 

I 

3525 

! 

1 

1 

3528 

1  Load  the  starting  value  for 

a  nn  TO  nn  loop. 

1 

3530 

! 

3 

1 

3532 

Load_start !Start„index»UAL<  Temp®  > 

•Previous  number  is  begin  value 

1 

3534 

TewpS*" “ 

i 

1 

3536 

For_flag«2 

•Next  value  will  be  ending  value 

; 

3538 

RETURN 

3540 

! 

i 

3542 

!  Load  the  ending  value  for  a 

nn  TO  nn  loop. 

f 

i 

3544 

1 

3546 

Load_endJEnd_inde>?®UAL(  Temp* ) 

!So  put  it  in  end  index 

; 

3548 

FOR  Ualue»Start_indflx  TO  End_lndex 

•And  execute  the  loop 

J 

3550 

Outarray< Array len )»Ualue 

! Store  the  value  in  output  array 

5 

3552 

Array len=Arraylen+l 

! Increment  output  array  pointer 

< 

3554 

NEXT  Ualue 

3556 

Te.--ip$»"“ 

3558 

For_f lag=0 

•Reset  the  for  flag 

3560 

RETURN 

f 

1 

3562 

! 

{ 

i 

i 

3564 

!  Execute  a  nn  TO  nn  loop 

3566 

1 

3568 

Run_loop:Step_val*UAL<  Temp$ ) 

•load  step  with  this  value 

3570 

FOR  Ualue«Start_index  TO  End_index+Step_val/l00  STEP  Step_vs] 

3572 

Qutarray< Array len  )»Ualue 

•Load  values  in  out  array 

3574 

Arraylen*Arhaylen+l 

1  Increment  output  pointer 

3576 

NEXT  Ualue 

3578 

TeMp**^"” 

3580 

Step_val*l 

3582 

For_f lag-0 

•Reset  the  for  flag 

3584 

RETURN 

3536 

! 

3588 

•  Here’s  where  we  end  up  if  an 

error  has  been  trapped. 

3590 

1  The  only  check  Is  to  see  if 

the  array  has  overflowed. 

■ 

3592 

!  If  it  has,  the  number  of  points  is  calculotcd  and  the  routine 

3594 

1  is  exited  normally.  If  not. 

the  error  number  is  reported 

3596 

!  and  the  program  hangs. 

3598 

1 

3 

3600 

Error line: IF  ERRN=17  THEN 

i 

3602 

SELECT  For_flag 

f 

3604 

CASE  2,3 

« 

3606 

Arraylen*'Arraylen+<  End_lndex-Ualue  )/Stcp_val 

i 

3608 

CASE  0 

1 

3610 

Array len=Arraylen+ 1 

3612 

CASE  ELSE 

3614 

Array len*- 1 

7, 

3616 

END  SELECT 

1 

3618 

GOTO  Done 

1 

r 

3620 

ELSE 

i 

3622 

BEEP 

3624 

PRINT  TA8Xy<S,10>i"ARRAYBUILD:  Error  #’‘&UAL$<ERRN  )&"  has  occured." 

3626 

PRINT  TABXYIS, It  )! "Program  idle." 

3628 

Oead5:60T6  DeadS 

3830 

END  IF 

3632 

1 

3634 

L  Here’s  where  we  end  up  if  we 

find  a  bad  syntax. 

3636 

1 

w 


3S4S 

3B48 

3650 

3652 

3654 

3656 

3658 

3668 

3662 

3664 

3666 

3668 

3678 

3672 

3674 

3676 

3678 

3680 

3682 

3684 

3686 

3688 

3690 

3692 

3694 

3696 

3698 

3700 

3702 

3704 

3706 

3708 

3710 

3712 

3714 

3716 

3718 

3720 

3722 

3724 

3726 

3728 

3730 

3732 

3734 

3736 

3738 

3740 

3742 

3744 

3746 

3748 

3750 

3752 

3754 

3756 

3758 

3760 

3762 

3764 

3766 

JO&ltm 


SUB:  Fiberidant 

1  FIBER  IDENTIFICATION  NODULE  ■  UERSION  2.1 

CON  /Fibe^/  Fib€r_id*  ,Fib6r_lan,Log_tir\e$ 

DIM  Idtt803.Len*t801 

ImUIMASE  i, "Please  enter  the  fiber  Identification!  "  ,K 
OUTPUT  KBD  USING  Ini 
BEEP 

ENTER  KBD  USING  In  hid* 

IF  LEN<Id*>  THEN 
Fiber_ld*=Id* 

END  IF 

In2!lNA6E  4, "Please  enter  the  fiber  length  in  neters  (or  zero):  "  ,K 
OUTPUT  KBD  USING  In2 
BEEP 

ENTER  KBD  USING  In2!Len* 

IF  LEN(Len*)  THEN 
Flber_ien«UAL( Len* )/ 1 000 
END  IF 

CALL  Cleardisplay 
SUBEND 


1 

SUB  FibertypetOPTIONAL  Fiber.type) 

1  FIBER  TYPE  SPECIFICATION  MODULE  UERSION  2.1 

COM  /Align_paran/  A( * > 


Get_typet  t 

IF  NPAR<t  THEN 

INPUT  "Please  enter  the  fiber  type  <20,  50,  85,  100,  or  150):  "  ,Ftype 
ELSE 

Ftype=Fiber_type  !If  fiber_type  argument  is  included,  use  it 
END  IF 


I 

SELECT  rtype  • 

CASE  20 
A<0)*1 

A(  1  )=10  !Rough_d>c 
A<2)=10  !Rough_dy 
A(3)=100  !Rough_dz 
A<4)=4  iFine_d>; 
A(5)*'4  !Flne_dy 
A(6)=^15  iFine_dz 

CASE  50 
A{0)*l 

A(t)=20  !Rough_ds 
A<2)=20  !Rough_dy 
A<3)»160  tRough_dz 
A(4)=8  !Flne_dx 
A<5)*8  !Fine_dy 
A(B)=20  !Flne_dz 


iQueried  to  see  if  fibertype  has  been  set  ( iio“0 ) 
•Step  size  for  rough  alignment 


•Step  size  for  fine  alignment 


150  micron  fiber  diameter 

IQueried  to  see  if  fibertype  has  been  set  <no-0) 
IStep  size  for  rough  alignment 


IStep  size  for  fine  alignment 


CASE  85 
A<0)*t 
A< 1  )*3e 
A<  2  )=36 
A<  3  )='272 
_ &i-A  ^=i7 


!  Rough„ri>', 
1  Rough„dy 
IRough_dz 


185  micron  fiber  diameter 

{Queried  to  see  if  fibertype  has  been 

•Step  size  for  rough  alignment 


Rtpn  fnr  f 


set 


( no~0 ) 


I 


t nr  nlionmenf 


^  1  in 

unoc.  ixiu 

1  1  ui  Ul«  1  Jl  u  -  1  V  i  vl'»‘  L 

3778 

A<0>«! 

IQuerled  to  see  if  fibertype  has  been  set  (no=0) 

3^80’ 

A! 1 1*40 

tRough_.dx 

{Step  size  for  rough  ailgnrient 

3782 

A<2)»40 

1 RoUgh_dy 

3784 

A(3)»300 

1 R6ugh_d2 

.  1 

3786 

A!4)-12 

t  F 1 ne_dx 

(Step  size  for  fine  alignment 

37S8 

A!S)«12 

1Flne_dy 

3790 

A!e)a50 

IFine^ds 

3792 

1 

3794 

CASE  150 

!I50  micron  fiber  diameter 

3796 

A!0)*1 

IQuerled  to  see  if  fibertype  has  been  set  ( no=0 ) 

3798 

A! 1  )a60 

!  Rough_d.'; 

IStep  sire  for  rough  alignment 

3800 

A!2)«60 

! RoUgh_dy 

3802 

A!3)s«300 

IRough_d2 

3804 

A!4)«i6 

IFlne_dx 

ISt’p  sire  for  fine  alignment 

3806 

A!5)«16 

IFlne_dy 

3803 

A!6)»S0 

IFlne_d2 

3810 

! 

3812 

1  If  the  user 

‘  didn’t  supply  a  valid  fiber  type  !no  CASE  match),  come  hare 

3814 

! 

3816 

CASE  ELSE 

3818 

BEEP 

3820 

GOTO  Get_ 

.type 

3822 

END  SELECT 

3824 

SUBENO 

3826 

! 

3828 

! 

3830 

SUB  Fiber  load! String*  ) 

3832 

3834 

1  FIBER  LOAD 

MODULE 

VERSION  2, IP 

383S  !-*f »*•#*»*»*#***•##»»*»*»*####**»*#****»#**»»*»**»»*.#♦»»*«♦» ****»- 

3838  COM  /lopaths/  @Foa2000  ,@EgaS205  ,®Tel'.7854  .©Bncdelay  ,Prlnter_sdd 
3840  CALL  F20008end( "ALIGN" ,1 ) 

3842  LOCAL  @Foa2000 

3844  OUTPUT  KBD  USING  "t.K’TK" 

3845  PRINT  TABXY( 1,10) » String* 

3848  BEEP 

3850  ON  KEY  5  LABEL  "PROCEED"  GOTO  Proceed 

3852  Here: GOTO  Here 

3854  Proceed: OFF  KEY 

3856  CALL  F20008end( "STAGE0"  ,1  ) 

3858  OUTPUT  KBD  USING  "#,K":"K" 

3880  SUBEND 
3862  I 
3864  I 

3866  SUB  Specwavesl String*  ) 

3868  !+#***»#**##**•******#*********«*»»*******»******•******♦*♦»♦**'►»»'>♦♦•*♦♦  + 

3870  I  SPECTRAL  ATTENUATION  WAVELENGTHS  MODULE  VERSION  2.1 


3872  I -#»#»♦*»#**»••*♦»*#»»»##*»»*#**##•****•»**•»*»«***»**»*»»•»♦**»»»» *♦••»•- 
3874  COM  /Wavelength/  Wavelength!  »)  .Nurnsteps 

3876  COM  /Sysdata/  Serlal_nui*tS  , Lasers!  »>  ,Fi  1  ler  _f  lag  ,F i  It er(  ,Wum_forijs  .Focu 
6<  *  )  .Cutoff  ,Lott_uave  ,Hlgh_wave  ,Det_5uiHch 
3878  ! 

3880  f  The  array  builder  parses  the  user’s  input  string  and  builds  a 
3882  !  wavelength  array. 

.3884  1 

3886  CALL  Arraybul ld< String* .Wavelength! *)  .Numsteps  ) 

3888  IF  Nuwstep»<=0  THEN  fARRAYBUILD  got  an  efror? 

3890  BEEP 

3892  DISP  "SPECWAVES  —  Bad  command  format.  Program  idle." 

3894  OeadliGOTO  Dead! 

3896  END  IF 


30  THEN 


•  ChecI'  for  more  than  100  values 


t  X  t 


'Set  number  of  .steps  to  350 


39^6  NuMstep8»3S0  iSet  number  of  .steps  to  350 

3908  END  IF 

3?t0  f 

3912  1  Now  u«  just  check  to  See  if  the  values  are  all  within  the 

3914  1  valid  rarifte. 

3918  1 

3918  FOR  lndax*0  TO  Nunsteps-I 

3920  IF  Wevelenflthf Index  XLou  wave  THEN 

3922  BEEP 

3924  OISP  "SPECMRUES  —  A  wavelength  below  ‘'8iUAL$<Low_uave  )&"  nm  is  speci 

fled.  It  will  be  set  to  ''&UAL$<Lou  uave>8i”  nm." 

3928  WAIT  3 

3928  Wavelengtht Index )*Lou  wave 

3930  END  IF 

3932  IF  Wavelengthi Index )>High_uave  THEN 

3934  BEEP 

3938  DISP  "SPECWADES  —  A  wavelength  above  "8iWAL$(HiQh_uave  )&"  nm  is  spec 

if  led.  It  will  be  set  to  "8.UALt(Hioh_uava  )&"  nm." 

3938  WAIT  3 

3940  Wavelengthf Index )«Hlgh_wave 

3942  END  IF 

3944  NEXT  Index 

3946  DISP  "" 

3948  SUBEND 
3950  ! 

3952  ! 

3954  SUB  Setfocusf Wavelength ) 

3956  !+»****»**#»**#*♦**»*»#****♦***•********»****♦»*#»*♦»•#*•»#*»)•«»**♦#*»•»#+ 


3958  !  SET  FOA-2008  FOCUS  CORRECTION  MODULE 


VERSION  2. 


3982  COM  /Sysdata/  Serial_nuM* .Lasers! *)  ,F1 1 ter_f lag  ,Fl 1 ter( ♦>  ,Num_focus  ,Focu 
s( *  )  .Cutoff  ,Low_wave ,High_wave ,Det_switch 


1  r 

3964 

INTEGER  Index .Wavel ,Wave2 .Aindex .Cor.vel 

i  f 

3988 

DIM  CmdSt40] 

1 

3988 

Cmd$»"" 

V’ 

3970 

Axis$(0)="IN-X" 

P  f 

3972 

Axis$(  1 )="IN-Y" 

1  1 

3974 

Axls*(2)*"IN-2" 

i; 

3978 

! 

1  r 

3978 

•  Find  the  two  entries  in  the  focus  correction  table  that  arc 

m  i 

i;  ■’ 

3980 

!  the  desired  wavelength 

3982 

! 

3984 

IF  Num_focus<2  THEN  SUBEXIT 

i,  f 

3988 

FOR  Index®!  TO  Num_focus-l 

3988 

IF  Focus!  Index  ,0  )>®Wavelength  THEN  GOTO  E>’.it_loop 

3990 

NEXT  Index 

3992 

1 

t  11 

3994 

!  Next,  get  the  correction  value  for  the  specified  wavelength 

3998  f  each  axis.  If  the  specified  wavelength  was  not  found  in  the  array, 
3998  !  interpolate  between  the  adjacent  values  to  compute  the  correction 
4000  i  value.  This  process  is  dons  for  each  axis  <X,  ,  and  7). 


4004  Exit„loop:FOR  Aindex*1  TO  3 
4008  GOSUB  Get.cor 

4008  Cmdf»Cnd*8.UAL*(Cor  val  )&"  "8,A.xi5$(  Aindex-1  )&' 

4010  NEXT  Aindex 

40 1 2  CALL  F2000sand<  C«d$ . 1 ) 

4014  SOTO  Done 

4016  6et_cdr :Mave1=*Focu6<  Index-t  ,0) 

4018  Wave2*Focus! Index  ,0 ) 

4  020  Ual 1*Focus< Index- 1  .Aindex  ) 

4022  Ual2=»Focus<  Index  .Aindex  ) 

•mi  r>  I  ..I  I  (  1  I  / 1 1 1  -1  1 1...  I  I  \  ..  I  II 


!6et  the  correction 
I  And  send  it 
!Do  the  next  axis 

I  All  done 


■’  1 1 1  I 


4034  SUB  Sp6rerun<  OPTIONAL  Spotf  .Runnsg*  > 

4036  t+*»*******#************»***#***»»««**»»#*»#*t»*»*##,##***«»**#»«»»*»«.»*#*  + 

4038  I  RUN  SPECTRAL  MEASUREMENTS  MODULE  ■  UERSION  .  1 

4040  »»t«  »»« »♦  I  #»f»«  Ilf  fff  f  f  ffffff- 

4042  DIM  Runit80J 

4044  IF  NPAR<2  THEN  Ilf  DMA  Is  not  specified,  assume  spec  atten  meas. 

4046  Rufif“"Sp«etral  attenuation  measurements  in  process" 

4048  ELSE 

4050  Run^eRunmsgf 

4052  END  IF 

4054  Spot_flafl»l 

4056  ICheck  for  over-filled  launch  specification 
4058  IF  NPAR>0  THEN 

4060  IF  <P0S<Spot$.’T"  )<>0  OR  POS( Spot* , " f "  )<>0  )  THEN 

4062  Spot_flag»0 

4064  Run**RunS&‘' 

‘‘&"Lauhch  overfilled." 

4066  END  IF 

4068  END  IF 

4070  CALL  Rundisplay< Run* ) 

4072  CALL  SpecmeaB( 0 ,Spot_f lag  ) 

4074  CALL  Cleardisplay 

4076  SUBEND 

4078  I  ^ 

4080  ! 

4082  SUB  SpacrafI OPTIONAL  Direct*  .RunmsgS  ) 

4084  !+»*#t<‘***##»**#*«»*****»»**»****»****«*f»ff***»*«ft»«***»»f»f*t**ff»»*f*+ 

4086  !  SPECTRAL  ATTENUATION  REFERENCE  MEASUREMENTS  MODULE  VERSION  2.1 

4088  !-***»*«*#**#**f*»#**»»»****»***»*»»#*»*******«#»**»«»»#f«f»f«f»»****»»»#- 

4090  DIM  Run*C200] 

4092  Crlf*«CHR*< t3)&CHR*(l0) 

4094  Spot_flag-l 

4096  IF  NPAR>0  THEN 

4098  IF  <POS<Dir€ct*.''F“  )<>0  OR  P0S(  Direct*  f "  >0  )  THEN  Spot  flag^0 

4100  I 

4102  •  Direct*  was  included,  so  check  for  a  "D"  or  "d" 

4104  ! 

4106  IF  P0S<Dtrect*,“0" )  OR  POSIDirect* ,"d"  )  THEN 

4108  1 

4110  !  Now  check  to  see  if  and  uncorrected  run  was  specified. 

41 12  ! 

4114  IF  POS<Direct*,"U“ )  OR  POS<Direct*  ,"u"  )  THEN 

41  16  1 

4118  I  A  Direct  Uncorrected  run  is  requested. 


IF  NPAR<2  THEN 

Run*® "Collecting  uncorrected  direct  reference  data"8.Crl  f*8."  for  s 


pectral  attenuation." 


Run*='  Coilect ing  uncorrected  direct  reference  data  "iiCrl  f S&Runmsg 


END  IF 

IF  Spot_flag®0  THEN  Run*®Run*&Crl f*&"Launch  overfilled." 
CALL  RuhdlSplayfRun# ) 

CALL  Specmeasf 2 ,Spot_f lag > 

CALL  Cleardisplay 
ELSE 


Uncorrected  NOT  specified,  do  a  corrected  direct  reference  run. 


IF  NPAR<2  THEN 

n, ,,  .f  o  .  I  !  ,  .  (  j  „„  ,-1. .  I  „„  f ,,,  I - -  ,  t  „  f  p  f  .  1  r  ^-1 


J  .,1  .  i  i 


ixsi. 

4tS8 

4160 

4162 

4164 

4166 

4168 

4170 

4172 

4174 

4176 

4178 

4180 

4182 


END  IF 

IF  Sp6i_f  1^0*0  THEN  Runt*Runf&Crl f$8i" Launch  overfilled." 
CALL  RUndl«pl4y<Ruh* ) 

CALL  Specmaasi 3  ,Spot_f  lag ) 

CALL  Clsardisplay 
END  IF 
ELSE 
60T0  Ref 
END  IF 
ELSE 
I 

!  The  Direct*  string  did  not  contain  a  "D"  or  "d"  or  the  direct* 

!  paraneter  uas  not  specified,  so  do  a  short-fiber  reference  run. 
! 


4184  Ref:  1 

4186  IF  NPAR<2  THEN 

4188  Run*®" Collecting  spectral  attenuat lon"8.Crl f*&"reference  data." 

4190  ELSE 

4192  Run**“CollectinQ  “IRunnsgSi"  reference  data." 

4194  END  IF  ‘ 

4196  IF  Spot^flag®0  THEN  Run*»Ruh*&Crlf*8i"Launch  overfilled." 

4198  CALL  Rundi splay < Run* ) 

4200  CALL  Specneasi 1 ,Spot_f lag  ) 

4202  CALL  Cleardisplay 

4204  END  IF 
4206  SU8EN0 
4208  ! 

4210  ! 

4212  SUB  SpecneasIRun.f lag .OPTIONAL  Spot) 

4214  !+#*###**♦#***#******•#•**♦»»»*♦**•♦****•**•***•*♦♦«*♦**#»♦***»»«♦**♦♦♦*+ 

4216  t  SPECTRAL  ATTENUATION  MEASUREHENTS  MODULE  VERSION  2. IP 

4218  !-»**§********♦*#•##»#***********«*♦*#**§*»»«»»»♦•«»»*#♦♦♦•##*»*»*»♦♦«♦*- 


4220  COM  /Diskdrive/  Sysdrlve*  .Arcdrive* 

4222  COM  /Sysdata/  Serlal_num* .Lasers! •) ,F< Uer_f lag ,F1 lter( *) ,Nun_focus  Focu 

s< • >  .Cutoff  ,Lou_wavc .Hlgh^wave ,Det_8ultch 

4224  COM  /Fiber/  Flber_ld* ,Flber_len ,Log_t ine* 

4226  COM  /Wavelength/  Wavelength! *)  .Nunsteps 

4228  COM  /Specrundata/  Specrundata! * ) ,Specrun_id* 

4230  COM  /Specref data/  Specrefdata! * ) ,Specref_id* 

4232  COM  /Directref/  Specrefcor! • >  .Pulserefcor! *  )  .Pulsecorwave! »  '  ,Correct_f la 
g!  * ) 

4234  COM  /Cutoff/  Cutref! •) .Cutresult! *) ,Cutoff_id$  ,Cutoff_wave .First  .Last , SI 

ope  .Intercept 

4236  DIM  Filename*! 251 

4238  INTEGER  Inde;^ 

4240  r 

4242  1  Set-up  instruments  for  Spectral  Measurements 

4244  t 

4246  IF  NPAR*2  THEN 

4248  Spot^f lag®Spot 

4250  ELSE 

4252  Spot^flag=1 

4254  END  IF 

4256  IF  Filter.fiagOt  THEN 

4258  GALL  F20005end< "WAV  COUPL" > 

4260  EL-SE=  fFiiter„flag»1  means  bandpass  filters  used  and  not  monochroneter . 
4262  CALL  F2000send!"FiL  COUPL" ) 

4264  END  If 

4266  4F  SpoUlag  THEN 

4268  CALL  F20005end!* SPOT- IN"  ) 

4270'  '  ELSE' 

4272  CALL  F2000send< "SPOT-OUT"  ) 

fTMn  rr 


4 


4282 

42‘8# 

42W 

4288 

4290 

4292 

4294 

4298 

4298 

4300 

4302 

4304 

4306 

4308 

43t0 

4312 

4314 

4316 

4318 

4320 

4322 

4324 

4326 

4328 

4330 

4332 

•^■’34 

4336 

4338 

4340 

4342 

4344 

4346 

4348 

4350 

4352 

4354 

4356 

4358 

4360 

4362 

4364 

4366 

4368 

4370 

4372 

4374 

4376 

4378 

4380 

4382 

4384 

4386 

4388 

4390 

4392 

4394 

4396 

4398 

4400 

4402 

4404 


unt_t.  r t.tuwuat:i)u\  xt_t.UM4.it  / 

ELSE 

CALL  F2000«end<"XMIT'' ) 

END  IF  ‘ 

CALL  F20008and<"COUT  TARGET-OUT  FF-OUT",!) 

SELECT  Run^flag 

1 

1  For  fiber  Measurenents ,  store  data  in  Specrundata  array, 

1 

CASE  »0 

Sp«crun_id$®Fiber_ldSi"  "8iLog_t ine$ 

Speerundata( 0 ,0  )=NuM6teps 
Sp«erundata(0 ,1 )*Fiber_len 

I 

!  For  reference  or  direct  Measurenents ,  store  data  in  specrefdata  array. 

! 

CASE  »1  ,2,3 

Speeref_ld**F iber_i d$S "  "&Lo9_t iwe* 

Specrefdata<0 ,0  )~Nunsteps 
Specrefdata<0,1  )®Flber_lert 
CASE  *4 

Cutof  f_idS=Fiber_id$8iLog_t  Iwe* 

Cutref(0 ,0 )«Nun8teps 
END  SELECT 
I 

!  Run  measurements  at  each  wavelength  in  the  wavelength  array 
! 

FOR  Index*©  TO  Numsteps-1  IMaKe  measurement  at  each  wavelength 

! 

!  Sat  the  FOA-2000  to  the  next  wavelength 
! 

CALL  Nextwave( Wavelength! Index ) ) 

IF  Run_flag*0  OR  Run_flag=l ^OR  Run_flag*4  THEN  i  Slip  focus  for  direct 
CALL  Setfocu3(Wavelength< Index  ) )  'Set  focus 

END  IF 

! 

!  Make  the  measurement  at  this  wavelength 
! 

Measurement*FNUoltmeter< .01  > 

I 

I  Now  store  the  measurement  in  the  appropriate  common  array 
! 

SELECT  Run_flag 
CASE  0 

Specrundata! Index+1 ,0 )*Wavelength!  Index ) 

Specrundata! Index+l ,1 )*Measurement 
CASE  =1  ,2,3 

Specrefdata! Index+1  ,0  )=Wavelength!  Index  > 

Specrefdata! Index+1 ,1 )=Mea5Urement 
CASE  *4 

Cutref < Index  +  1  ,0 )*UavelenQth! Index  ) 

Cutref! Index+1 ,1 >*Mea6urement 
END  SELECT 
NEXT  Index 

1 

I  End  of  measurement  loop 
1 

CALL  F2000send!  "0  IN-X  0  IN-Y  0  P*  “ ) 

1 

I  For  corrected  direct  meas.urements ,  the  direct  data  must  be  multiplied 
I  by  the  leunch  correction  factors  stored  in  the  common  array  Specrefcor. 

I 

IF  Run_flag^3  THEN 


U|  i  U  jr  i  w  V  ;  * 

4412  D«ad2;  SOTO  Oead2 
4414  ELSE 

44tS  lc'ffiet*0  aiibw  for  e>Ura  points  in  spcccor 

4418  FOR  TO  NuMSteps  ' 

4420  WHILE  Specrefdata(  Indfljt  ,0  )<>Specrefcor(  Inde:<+Iof  fset  ,0  ) 

4422  lof fsst^Iof f3et+ t  ^Search  ahead  for  a  wavelength  natch 

4424  IF  Inde>5+Iof  ffiet>Specrefcor(0  ,0  )  THEN 

4426  BEEP 

4428  PRINT  TABXY< 1  ,1 7 ) » "SPECMEAS  —  A  correction  factor  was  not  fou 

nd  for  a  wavelength  used  in" 

4430  PRINT  TABXY( 1  , 1 8  )  j “ the  direct-spot  neasurenents . " 

4432  Oeadi ;  SOTO  Deadt 

4434  ENP  IF 

4436  END  WHILE 

4438  Specrefdatat Index  ,1 J^Specref data< Index .1 )*Specrefcor< Indsx+Iof f set 

,n  lApply  the  correction 

4440  NEXT  Index 

4442  END  IF 

4444  END  IF 

4446  SUBENO 

4448  ! 

4450  ! 

4452  SUB  Specoor 

i+****»****»*«‘*******»**»»****#*»»»»»*»»»«**»»»»#»*»**»**»»*»#*)>»»*»»»»»»  + 

!  CALCULATE  SPEC  ATTEN  DIRECT  CORRECTICN  FACTORS  MODULE  VERSION  2. IP 

!-*#*»»•*»»♦#»»**»*«•**•*#***•#»•**•#»***»«*»»*»*»»*»»»«»#»•*»«»»»♦*»»»»)>- 

COM  /Diskdrive/  Sysdrlve®  "cdrlveS 
COM  /Specrundata/  Specrund>.(.a(  •  )  ,Specrun_id$ 

COM  /Specrefdata/  Specrefdatat ♦  )  ,Specref_id$ 

COM  /Oirectref/  Specrefcort  *  )  ,Pulserefcor< • )  ,Pul6ecorwave( *  ) ,Correct_f la 


4454 
4456 
4458 
4460 
4462 
4464 
4466 

g(  ♦  > 

4468 
4470 
4472 
4474 
4476 
4478 
4480 
4482 
h. " 

4484  Deadt:  SOTO  Deadt 


F i lenanei*" speccor" 

INTESER  Index 

Specref cor<  0 ,0  )*Specref data( 0 ,0 ) 

Specrefcor( 0 , t  )=Specref data! 0 , t  ) 

FOR  Index=t  TO  Specref data! 0 ,0 ) 

IF  Frjecrefdata(  Index  ,0  )<;>Specrundata(  Index  ,0  )  THEN 
BEEP 

DISP  "SPECCOR  Short  fiber  and  direct  data  wavelengths  do  not  natc 


4486 

4488 

4490 

4492 

4494 


ELSE 


Spccrefcorl  Index  ,0  )=Specref data!  Index  ,0  ), 

Specrefcort Index  ,t  )-Specrundata< Index , t  )/5pecref data(  Index ,  I  ) 
END  IF 
NEXT  Index 

4496  ! 

4498  !  Write  the  new  data  in  the  file  called  "speccor" 


4502  ON  ERROR  60SUB  Fiie_err 

4504  CREATE  BOAT  Fi lenanef&Sysdr ive$  ,2 1 0  ,8 

4506  ASSI0N  SOutfile  TO  Fi lenansS&Sysdr ive* 

4S08  OFF  ERROR 

45t0  OUTPUT  @0ut file? Specref cor< »  ) 

4512  ASSISN  iOutflle  TO  * 

4514  SOTO  Done 

45 f 6  Flle_err!lF  ERRN«54  THEN 
4518  PURSE  Filenanef&Sysdrivef 

4520  ELSE 

4522  PRINT  "SPECCOR  —  Err^.r  number  "&VAL$<FRRN) 

4524  Oead2:SOTO  dead2 
IF 


;  ^  SUS  Specatcomp 

'•^§30.  t.-f »••*»••«»•  *«»*••«•»»••§»••••  •.««»»»«»««»»»V»»»»»4>»«»*»»*»»»»'r*«»«»«i>««*  + 

;:4B40  I  SPECTRAL  ATTENUATION  COMPUTE  MODULE  VERSION  2.1 

4542  f-**«**’*«***#**»»********»»****»*»t»****»#»»****»**#**»t»»*»»***»»»#»»»»*»- 
'  4544  COM  /Spscfundaia/  Speerundatal ♦ ) ,Specrun_id$ 

4546  COM  /Spacrefdata/  Speerefdatal • ) ,Specref_i d$ 

4B48  COM  /Specattdata/  Specattdaial *  )  .Specatt  id$ 

.  45S«  INTEGER  Index 

4552  CALL  Rund I apl ay < "Computing  Spectral  Attenuation  Results.") 

4BS4  Length«Specpundata< 0 , 1 )  !If  fiber  length  is  not  given, 

4B5B  IF  Length**©  THEN  Length=4.G  ithen  use  1  for  length. 

4558  Specattdata<0 ,0 >=Specrundata(0 .0 )  iStore  the  number  of  points 

4560  Specattdata<0,n»Specrundata(0 ,1)  IStore  the  fiber  length 

4562  Specatt_id$*Specrun_id$  1  Store  the  fiber  id  string 

4564  ! 

4566  !  Now  Compute  the  results  at  each  wavelength 
4568  I 

4570  FOR  Index»l  TO  Specrundatal 0  ,0 ) 

4572  ! 

4574  !  Find  the  wavelength  in  the  REF  sample  that  corresponds  to  the  RUN. 

4576  I 

4578  Index  1*1 

4580  WHILE  Specrundatal Index  ,0 ><>Specrefdata( Indexi ,0  )  AND  Index  1 <=Spacrefd 

3ta(0,0} 

4582  Index1*lndex1+1 

4584  END  WHILE 

4586  IF  Index 1>Specrefdata( 0.0)  THEN 

4588  BEEP 

4590  PRINT  TABXY1 17 ,1  )i"SPECATCQMP  —  The  reference  does  not  contain  a  wa 

velength  found  in  the  measurement.  Program  idle." 

4592  Dead2;  GOTO  Dead2 
4594  END  IF 

4596  Specattdata! Index ,0 >*Specrundata( Index  ,0  )  I  Record  the  wavelength 

4598  IF  Specref data!  Index  1  , 1  >/Specrundata(  Index  ,  1  )<,=0  THEM 

4600  Specattdata! Index  ,  1)*-100 

4602  ELSE 

4604  Specattdata!  Index  ,1  )=t0*LGT!Specrefdata!  Index!  ,  I  )/Specrundata!  Inde.-‘. , 

1  )) 

4606  END  IF 

4608  I 

4610  •  Divide  by  fiber  length 

4612  I 

4614  Specattdata! Index ,1 )*Specattdata! Index  ,1  )/Length 

4616  NEXT  Index 

4618  CALL  Cieardisplay 

4620  SUBEND 

4622  1 


4624  ! 

4626  SUB  Specat list! OPTIONAL  Print_f lag* .Newt  it le$  ) 


4630  !  SPECTRAL  ATTENUATION  OUTPUT  LISTING  MODULE  VERSION  2.1 

4632  !-**#**»##**»*»»#***f*»*#**»#******»***»*«****«***«*»« »»«»*««***»»•♦**♦*••- 
4634  DIM  Title*[25] 

4B36  INTEGER  I 

4638  REAL  Oivby 

4640  COM  /lopaths/  0Foa2000 ,@Egg5205 ,@TeK496p  ,@Tek7854  ,Printer_add 
4642  COM  /Specattdata/  Specattdata! *) ,Specatt_id* 

4644  1 

4646  f  Now  set-up  the  table  output 
4648  1 

4650  OUTPUT  H8D  USING  "t,K"5"K"  I  Set  up  screen  for  the  table 

4652  I 

.  ^  t  r*r'  •  n  ^  ^  ^  ft  f  r*  r-  I  hr*  f  •  ,  ^  * 


t -"r  4  I  T  f  1 1. « 


-  1  ^  ri 


■^uOv  : 

4B62  Divby»t 
.,4864  IF  NPAR>0  THEN 

4666  IF  P0S<Prtnt_fU9$.”MET"  >  THEN  Divby-1000  ’ 

4688  IF  POS?Print_flagS/TEN"  )  THEN  Dlvby==I00 

4670  IF  P0S<PrInt_fia9f ."HUN" >  THEN  Divby*t0 

4672  IF  POS(PMfit_f  lags. "KILO" )  THEN  Divby=1 

4874  IF  POS<PMnt_flag*  ,"P"  )  OR  P0S<Print  flag$,"p")  THEN  Print_it 

4678  END  IF 

4878  ! 

4680  GOSUB  PMrtt.tbl 

4682  ON  KEY  8  LABEL  "PRINT"  GOTO  Print_it  i  Hardcopy? 

4684  ON  KEY  5  LABEL  "CONTINUE"  GOTO  Done 

4686  BEEP 

4688  Wai inheres GOTO  Wait_h6ra 
4630  Prtnt_itJOFF  KEY 
4692  PRINTER  15  Printer^add 

4694  GOSUB  Prlnt.tbl 

4696  PRINT  !Put  sone  white  space  at  the  bottow 

4698  PRINT 

4700  PRINT 

4702  PRINTER  IS  I 

4704  GOTO  Done 

4706  Print_tbl;  ! 

4708  IF  NPAR<2  THEN 

4710  PRINT  "SPECTRAL  ATTENUAilCM" 

4712  PRINT  " - " 

4714  ELSE 

4716  PRINT  Neutitle® 

4718  END  IF 

4720  PRINT  "FIBER  IDj  "&Specatt_id* 

4722  PRINT  "LENGTH:  "  iSpecattdata<  0 , 1  )  5 " 

4724  PRINT 

4726  IF  SpBcattdata(0,l  )«0  THEN 

4728  Title*»"ATTENUATION  <dB)" 

4730  ELSE 

4732  IF  Divby=l  THEN  Tit le$=" ATTENUATION  (dB/Kn)" 

4734  IF  Divby«10  THEN  Tit le®*"ATTENUATlON  (dB/l00n)'’ 

4736  IF  Oivby*100  THEN  Title$*"ATTENUATION  <dB/10m)" 

4738  IF  Oivfay=1000  THEN  Tit le$="ATTENUATION  (dB/n)" 

4740  END  IF 

4742  PRINT  "WAVELENGTH  "jTitieS 

4744  PRINT 

4746  FOR  I»f  TO  Specattdatal 0 ,0 )  i  Print  the  table 

4748  PRINT  USING  "4/ ,4D  ,  I0X  ,BD,4D“ »Specaltdata(  1 ,0  )  .Specattdatad  ,  1  )/Ui vby 

4750  NEXT  I 

4752  RETURN 

4754  Done:OUTPUT  KBD  USING  "#,K"?"K"  '  Clear  the  screen 

4756  SUBEND 

4758  ! 

4780  ! 

4762  SUB  SpecatplotlOPTIONAL  Prij.t.flag®  ,Lou_uave  ,High_wave ,Newt 1 1 le$ ) 

4764  !+«*«»*#*«***»#**##«»•**#*»•*♦•#*•*##*♦***»****«»»»****•«*«♦»♦♦•»*♦♦«♦»»»+ 

4766  I  PLOTTER  FOR  SPECTRAL  ATTENUATION  VERSION  2.1 

4768  l-«******#******#****#**«*»«»**»**»*» »»*♦*»**«*»»«»*♦»♦»•*♦»»***♦♦♦ ***♦»»- 

4770  COM  /lopaths/  @Foa2000  ,@E9g520S ,@Tel'496p  ,@TeK7854  ,Pr inter_add 
4772  COM  /Specattdata/  Specettdatal  • ) ,Specatt,_id$ 

4774  INTEGER  Index 

4776  INTEGER  Lowave 

4778  REAL  Oivby 

4780  DIM  Xlabel$t403,Ylabel$U0] 

4782  Oivby*!  !  In  case  this  parameter  isn’t  passed 

4784  Top:  I 


"turn 


t  t  u.t  t  4^  k  .  i  I  • 


't  i  'Ju  xi  iuuviixnv^»iay4»,tiuM  / 

4794  IF  POS<Priot  f lag*  , “KILO"  )  THEN  Divby^l 

4796  END  IF 

4798  ! 

4800  Unitialise  plotting  labels  and  Units 
4802  I 

4804  Xiabelt*“Wavelength  <um)“ 

4806  IF  Specattdata<0.t  )«0  THEN 

4808  Ylabelta-dS'' 

4810  ELSE 

4812  IF  Divbyal  THEN  Ylabel*="dB/kn" 

4814  IF  Divhy=10  THEN  Ylabel*=“d8/100n'' 

4816  IF  Divby*100  THEN  Ylabel*“"dB/ 1 0m" 

4818  IF  Divby»t000  THEN  Ylabel*="dB/n" 

4820  END  IF 

4822  ! 


4824  IF  (NPAR>1  >  THEN 

4826  IF  Lotj_uave>0  THEN 

4828  Min>!*Lou_uave 

4830  ELSE 

4832  Min>?*Specat  tdata<  1  ,0  > 

4834  END  IF 

4836  ELSE 

4838  IF  Print_flag$="2"  THEN 

4840  INPUT  “Enter  the  nlniMUM  wavelength  value  in  nM:'‘,Hin>. 

4842  ELSE 

4844  Minx*Specattdata( 1 ,0 ) 

4846  END  IF 

4848  END  IF 

4850  IF  <NPAR>2>  THEN 

4852  IF  High_wave)0  THEN 

4854  Maxx»HiQh_uave 

4856  ELSE 

4858  Max/aSpecat tdata( Specattdatal 0 ,0 )  ,0  ) 

4960  END  IF 

4862  ELSE 

4864  IF  Print_flag*-”2‘'  THEN 

4866  INPUT  “Enter  the  MAXIMUM  wavelength  value  In  ntn;  "  ,lia:-,x 

4868  ELSE 

4870  Maxx»Specattdata( Specattdata( 0 ,0 ) ,0  ) 

4872  END  IF 

4874  END  IF 

4876  Minx=INT<Minx/100)*100 

4878  Maxx®INT(<Maxx+99)/t00)*100 

4880  Mlny*0 

4882  Maxy»0 

4884  FOR  Index-I  TO  Specattdata( 0 ,0 ) 

4886  IF  < Specattdata( Index  ,  1  )/01vby  )>Maxy  THEN  Maxy=Specattdata< Index  ,  1  )/Di 

vby 

4888  NEXT  Index 

4892  Maxy=INTI<M9«y+4)/5)«5 

4892  IF  Maxy<5  THEN  Maxy»5 

4894  IF  Maxy>20  THEN  Maxy*20 

4896  Ticx*<Specsttdaia(Specattdata(0,0) ,0 >-Specattdata< I ,0 ) )/l0 

4898  Tlcx*INT(Ticx/10)*10 

4900  Ticy*l 

4902  I 

4904  Unitialise  screen,  set  line  type  to  dotted,  and  draw  the  grid 

4906  f 

4908  GIMIT 

4910  GCLEAR 

4912  GRAPHICS  ON 

4914  CSIZE  5, .55 


4924  IF  Spec:attdata<0,n»0  THEN 
4926  LABEL  “SPECTRAL  ATTENUATION" 

4929  ELSE 

4930  LABEL  USING  . SPECTRAL  ATTENUATION  LENGTH:  "".DD.DDDD," 

Spaasttdata{0 ,1 ) 

4932  END  IF 

4934  ELSE 

4936  LABEL  "  “8.Newtitlet 

4938  END  IF 

4940  PRINT  TABXY< 1  ,2)5 

4942  PRINT  "ID:  "8,Specatt_id$ i 

4944  PRINT  USING  "2X  , BA  , DO. ODD  ,3A" » "Length:  "  .Specattdata( 0 . 1  > ,“  I  n" 

4946  UIEWPORT  20 ,92*RATIO  ,30  ,86 

4948  WINDOW  Mifij!:  .Maycx  ,Miny  .Maxy 

4950  LINE  TYPE  4 

4952  GRID  Tlcx ,Tlcy  .Minx  .Miny 

4954  I 

4956  (Reset  the  line  type  to  solid,  and  plot  the  data 
4958  I 

4960  LINE  TYPE  I 

4962  FOR  Index*!  TO  5pecattdata( 0  ,0  ) 

4964  PLOT  Specattdatal Index ,0)  ,Specattdata( Index  , I  )/Divby 

4966  NEXT  Index 

4968  ! 

4970  tSet  the  label  node  to  center,  units  to  degrees,  rotation  to  zero 
4972  (degrees,  and  expand  the  hard  clip  to  r.al;e  room  for  the  labels. 
4974  (Then  set  the  label  size  for  the  x-axis. 

4976  I 

4978  LORG  5 

4980  DEG 

4982  LDIR  0 

4984  UIEWPORT  0 , 1 00*RATIO  ,0  . ! 00 

4986  WINDOW  0 , 1 00*RATIO  .0 , 1 00 

4988  CSIZE  6, .6 

4990  ! 

4992  (Label  the  x-axis 
4994  ! 

4996  MOUE  70,18 

4998  LABEL  Xlabel$ 

5000  CSIZE  4,. 65 

5002  LORG  6 

5004  FOR  Xpos=20  TO  123  STEP  l00»Ticx/(Maxx-Minx  )*2 
5006  MOUE  Xpo6,2g 

5008  LABEL  USING  "O.DD" j<Xpo6“20)/100»<Maxx-Mlnx  )/1000+Minx/1000 

5010  NEXT  Xpos 

5012  I 

5014  (Change  to  the  Y-axis,  put  the  title  on  the  y-axis,  then 
5016  (label  the  grid  marlvS  on  the  y-axls. 

5018  ! 

5020  CSIZE  6,.S 

5022  LORG  5 

5024  MOUE  8,S3+LEN(Ylabel$)*3 

5026  FOR  1*1  TO  LEN<Ylabel$) 

5028  LABEL  YlabeiSIIjI I 

5030  NEXT  I 

5032  CSIZE  4,. 6 

5034  LORG  8 

5036  FOR  Ypos*30  TO  88  STEP  56*Tlcy/(Maxy-Mlny ) 

5038  MOUE  tg.Ypos 

5040  LABEL  USING  "DO"  i  <  Ypos-30  )/S6*<May,y-Miny  >+Miny 

5042  NEXT  Ypos 

5044  ( 


i  wii  f  W  V  }  I  J.  1 1  V 
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I 


I  iHv^t  A.tty«M  ,  i  i  wii  f  wvi  I  j.tiv  . 

J^^■' 

s4t  up  k#ys  for  operator  interaction 


r  ■%  »,»'  • 

rcwsass;; 


'  .see*; 
';;sil^ 

seM. 

5*68 

,s*7»; 

5072 


ON-.klv;  I.  tABEL  "RESCALE  PLOT*  SOTO  Rescale 


OMKET  2  LABEL  *  PRINT 
ON  KEY  y  LABEL  *  StORE 
ON  KEY  5  LABEL  "  QUIT* 
ON  KEY  R  LABEL  *  PRINT 
WiitJSOTO  Wait 


L1STIN6*  SOTO  Listing 
OATAnSOTO  Storeit 
SOTO  Quit  it 
PLOT*'  SOTO  Print_piot 


5074  Rescale;  PMct.f laQ$="RESCALE" 
5076  CALL  Cleandispiay 
5078  SUBEXIT 

5080  Listing;  PMOt_fUa*e"LISTING" 
5082  SUBEXIT 


5084  Stoneit:  PMnt_Flau$*“STORE" 
5086  CALL  Cleardisplay 
5088  SUBEXIT 

5090  Quitit;  Prtnt_flaQ*»"QUIT" 
5092  SUBEXIT 


5094  Print_plot:  OFF  KEY 

5096  OUTPUT  KBD  USING  "#  ,K“ » " I  " 

5098  DUMP  GRAPHICS 

5100  OUTPUT  KBD  USING  "t.K";"!'' 

5102  GOTO  Top 

5104  Returti:GINIT 


E 

I 

E 

I 

I 


5106  GCLEAR 
5108  SUBEND 
51 10  I 
5112  ! 

5114  SUB  Nfialdval8<String$) 

5116  I 

5118  !  NEAR  FIELD  VALUES  SPECIFICATION  MODULE  VERSION  2.1 

5120  !-•«»*•»»#***#*♦**»♦*•♦*•»•»»**»#*.•»•**#»#*#***»*»**.»»****.»•♦»»«»»»*.#- 

5122  COM  /Nearfield/  Nf ieldvaK * ) ,Nun_points  ,Nearf ield( •  )  ,Nf leld_idt 
5124  t 

5126  !  The  array  builder  parses  the  user’s  input  string  and  builds  a 

5128  !  wavelength  array. 

5130  I 

5132  CALL  Arraybuildl String® ,Nficldval< *) ,Nun_point5 > 

5134  IF  Nun_points<0  THEN  ! Array  builder  got  an  error? 

5136  beep” 

5138  DISP  "NFIELDVALS  —  Bad  command  format.  Program  now  hung  in  a  loopihi 

t  PAUSE  or  STOP)" 

5140  Dead l: GOTO  Deadl 


ri 


I 


5142 

END  IF 

• 

5144 

IF  Nun_point5)200  THEN 

•  ChecI'  for  more  than  100  points 

5146 

BEEP 

5143 

DISP  "NFIELDVALS  —  More  than 

200  points  are 

specified.  Extras  will  be 

ignored.  “ 

51 B0 

WAIT  3 

5152 

Nun_points=200 

!And  set 

number  of  points  to  190 

5154 

END  IF 

5156  ( 

5158  1 

Now  check  to  see  if  the  values  are  all  within 

the  valid  range. 

5160  1 

5182 

FOR  Index*©  TO  Nun^polnts-1 

5164 

IF  Nfieldvel(l!tde.'c)<-250  THEN 

5166 

BEEP 

5168 

DISP  "NFIELDVALS  —  A  value 

less  than  -250 

is  specified.  It  will  be 

set  to 

“250.* 

5170 

WAIT  3 

r  * 

Mf  )  1  J...  1  /  t  ...J,  N-.-lCO 

lfeffc?'i'S't<4;iWS$b,v “  ft  value,  greater  than  250-is  specified.  It  will  b 

' sfiftm^ , .  .  -'V^  ^  ■  .  -  ■ 

9|  sue  Mfleldrtin 

99'-  »««»»»»««»»««*»#»»»»»«»»*##»»*«.*  #4. 

m  !  NEftR-FiELO  HEftSUREHENTS  RUN  HOOULE  UERSION  2.! 

04  COM  /Nearfleld/  Nf  leldvait  »  )  ,Nun.^points  .Neat-f  ield(  *  )  ,Nf  ield_i d$ 

08  COH  /Fiber/  Ftber^id* ,Fiber_len,Lbg_^tlMa$ 

08  COM  /Syscal/  Pln^x  .Pin^y  ,Pln_r  ,InXi.5tep  ,Iny_slep  ,Outx_step  ,Outy_r.tep  .Far 
eld_step .Lfnolse 

10  INTESER  Index .Setting ,Heas  range .Maxloc 

12  OUTPUT  KBD  USING  "#.K‘rK“ 

14  CALit  Rundlepiayt  "Neab-f  ield  Measurements  in  progress.") 

IB  ! 

18  f  Sst  up  instruments  for  near  field  measurements 
20  I 

22  CALL  F200@send< "GERMAIN  LED  LED-ON  CHOP-ON  SPOT-OUT  XMIT  PIN-IN") 

24  CALL  F2000send< "UOUT  0  ATTENUAT  FF-OUT"  ) 

28  CALL  F20008end< "OUTX  COUPL"  ) 

28  1 

30  I  Now  move  the  stage  to  correct  for  the  actual  pinhole  position 
32  1 

34  CALL  F20005end(VAL$(Pin_y)&"  OUT-Y  "&UAL$( Pin_z  >8."  OUT-Z"  > 

36  I 

38  1  Measure  the  signal  at  the  fiber  center,  and  fix  the  lock-in  scale* 

40  I 

42  Reading»FNUoltmetor( . 1 ) 

44  Peakval«Z*Reading 

48  GALL  Setscalel . 1  .Peakval ) 


52  I  Take  the  measurements  at  each  specified  near-field  position 
54  I 

56  Maxval»0 

58  Setttng»2*Nf leldval<0 >-20  !  Backup  to  eliminate  backlash 

60  CALL  F2000Bend<UAL$I Sett ing+P in. x)8,"  0UT-X",1) 

62  FOR  lndex*1  TO  Num_polnt8 

84  Settlng=2*Nf leldvall  IndeX-1 ) 

66  CALL  F20008end(VALf<Setting+Pin_x  )&"  0UT-X".l-) 

68  Nearfleld!  Index  ,  1  I'sFNUoltmeterl  0 )  iGet  a  reading  from  5205 

70  Nearfleld!  Index ,0 )*Sett lng»Outx_step  IStore  X-axis  location 

72  I 

74  f  Remember  the  largest  value  and  its  location 

76  ! 

78  IF  Nearf leld! Index, 1 )>Maxval  THEN 

80  Maxval=Nearf ield!  Index , 1 ) 

82  Haxloc»Index 

84  END  IF 

next  Index 
88  1  . 

80  I  Now  put  the  stage  back  to  the  original  zero  value  before  correcting 

82  I  for  the  pinhole  position. 

34  ! 

96  CALL  F2000send!"0  OUT-K  0  OUT-Y  0  OUT-Z",!) 

I 


&K''  '  .3S"-H'5' ,  4'."^'?-“”’  i'tUri_pu  i  111.  ij 

5l|> ,  V  f;;Ntii?,fialS„<;tffdes ,  f  )*i!learf  leid(  Index  ,  1  >/Maxval 

vMS'|ig|;i'#ld^®4®,IfNdff(_;dplnis  IStore  nunljer  of  points  in  array 

"&ko9_tlmef  lAnd  store,  the  fiber  ID  &  tine 

225:^1:, . 

145  Nf  ieldpio.tt  OWIONAL  Print ^f  lags  ) 

28  I  fliAR  FIEhO  GRAPHICS  OUTPUT  MODULE  UERSION  2.1 

I ~44«»***«** *44*4 

32  IMTEBER  Indax 

34  COM  /MSarf i#ld/  Mf teldvalt* ) ,Num  points ,Nearfield( »>  ,Nfield_tdS 

36  Dim  Titl«tt4@1,XlabelSt40J 

is  r 

40  !  CoMpute  core  diameter  and  print  it  with  the  near  field  pattern  graph 

42  I 

CALL  CoredieM<Nearf  ield<  *■)  .Core^dian ) 

Core^diaM*.  l'*iNT<  10*Core  dlaw+iS)  iRound  the  results 
TttleS**NEAR  FIELD  PATTERN" 


44 
46 
48 
B0 
52 
54 
56 
58 
50 
!62 
164 
166 
!68 
570 
572 
J74 
576 
578 
580 
382 
584 
388 
388 
330 
392  ! 

394  !  **  Senerate  the  frame  *• 

396 

398  MOUE  Minx.Miny 

400  IDRAW  Xsize,0 

402  IDRAW  0,Ysi2e 

404  IMOUE  -Xsize.O 

i06  lORAU  0.-Y8l2e 

408  ! 

4t@  f  *4  Generate  the  graticule  lines  *• 
4t2  I 

414  LINE  TYPE  4 

416  FOR  Inde5?s0  TO  5 

418  MOUE  Minx ,Miny+<Ysi2e»lndex/5) 

i420  IDRAW  X«i2a,0 

422  NEXT  Index 

424  FOR  lndex=*0  TO  8 

i426  MOUE- Mlhx+C Xsize^ Index/8  )  ,Hlny 

428  IDRAW  0,Ysl2e. 

1430  next  Index 


Xlabel$^"Dietance  (um)“ 
eiNIT 
GCLEAR 

gDaput«3 

UIEWPORT  0,100*RATIO,10.100 
MOUE  0,95.5 
CSIZE  5 
LABEL  Titles 
LABEL  "IDj  "&Nfield_td$ 

MirtX*-100 
Maxx»100 
Mlny*0 
Maxy«l 

X6i2e=ABS<Maxx-Mlnx ) 

Ysi2e=ABS(Maxy-Mlny ) 

Botborder»Miny-.2*Yslze 
Topborder»Maxy+. 1 •Ysize 
Lef tborder=Minx-.2*Xsi2€ 
Rgtborder=Maxx+,05»Xslze 
UIEWPORT  0,100*RATIO,18,95 

WINDOW  Lef tborder .Rgtborder .Botborder .Topborder 


!  Create  a  graph  layout  with  space  for 
!  labels 


I'  HOME:  N■sa^f,i,el,d^l  ,0 )  .Nearf  isid<  1,1) 

Hear fi«ld< 0,0) 

^4  .  OR^I'H^arf  iald(Ina«??,0),Nearfield(  Index,  1  ) 

IS;  ',NE)^f  ’IddiK 

m  I 

i0i  i  »*  Put  In  the  X-axis  graticule  labels  »* 

52  1 

54  CSIZE  4 

55  FOR  lndex*0  TO  8 

58  0alue»Mlnx+Index*X3i2e/8  ICopipute  the  value  of  the  label 

10  MOVE  Value-. @S»Xsl2e  ,Miny-.4i«(Mlny“Botborder  ) 

52  LABEL  USING  "S3D. " j Value 

14  NEXT  Index 

56  I  ^ 

58  XpO6*Minx+Xsi2e/2-LEM<Xlabel$)»(Xsi26/40)/2  ICowpute  place  for  XLABELS 

?0  ! 

?2  !  **  Print  the  X  label  string  ** 

?4  I 

?B  MOVE  Xpos  .Botborder 

78  CSIZE  S 

30  LABEL  X labels 

32  I 

34  I  **  Print  the  core  diameter  *♦ 

96  t 

38  WINDOW  0,t00»RATIO.10,t00 

90  VIEWPORT  0,100*RATIO,10,I00 

92  MOVE  0,9 

94  IF  Core_dtarii*0  THEN 

96  LABEL  "Core  diameter  not  found" 

98  ELSE 

00  LABEL  USING  "“"Core  diameter  *  " “ ,DDD.DD" tCore  diam 
02  END  IF 

04  IF  NPAR*!  THEN 

06  IF  UPC$<Print_flagStl  .n)»"P"  THEN  Print_it 

08  END  IF 

10  ON  KEY  8  LABEL  "PRINT"  GOTO  Print_it 

12  ON  KEY  5  LABEL  "CONTINUE"  GOTO  Done 

14  Wait_here:G0T0  Wait_here 
16  Print_lt:OFF  KEY 
18  OUTPUT  KBD  USING 

20  DUMP  GRAPHICS 

22  OUTPUT  KBD  USING  “t.K"?"!" 

24  DoneiGCLEAR 

26  GRAPHICS  OFF 

23  SUBEND 
30  t 

i32  I 

34  SUB  CorediamlNearf ield< *) .Diameter ) 

i3G  |+**#***#»»f*****#*##»#**«#*##»»»**»«»##»«**»*#*«»# »*#•»*«*«»**#♦» »*»»»*«+ 
.38  1  COMPUTE  CORE  DIAMETER  MODULE  VERSION  2.1 

i40  |-****#**»*#»##**##*«###**«**»#»#*#***** »»**»*♦««♦»♦»***♦♦»«»**»» »♦♦»*♦**- 

i42  1  This  module  computes  core  diameter  on  the  near-field  pattern. 

544  Threshold®. 025  !  Use  2.5%  points 

546  1 

548  I  First,  locate  the  15%  points  to  be  sure  we  are  off  the  noise 
550  !  f  loOr . 

552  I 

554  Diameter*© 

556  I  ndex*  1 

558  WHILE  Nearf leld< Index, 1 )<. IS 

580  tndex*Index+l 

562  IF  Inde>l>Neerfleld<0,0)  THEN  Done 


:  »threshold 

-"ism.  :  IF  THEN  Oon« 

5578.  ."END  WHILE 
■  -lift-  t 

5582’  I  Cinput*  in  iniarpolatpd  crossing 
558#'  I 

5i8E  Rt^Naarfloldl Index ,0y+<Nearf leld( Index+t  ,0  >-Nearf ield( Index ,0 ) )*( Thresho 
id“Ni«rf leld< Indax ,t ) y/<Naarfteld< Indax+1 ,1 y^Nearfleldl Index  ,  1  )  ) 

5588  f 

5590  f  Finally  search  forward  to  the  second  threshold  crossing. 

5S9Z  I 

5594  Index*Index+l 

5596  WHILE  Nearf leld< Index , 1  )>Thre8hold 

5598  lndex»lndex4-t 

5600  IF  Index>NearfleId<0,0)  THEN  Done 

5602  END  WHILE 

5604  R2*Nearf lald< Index  ,0  >+(Nearf ield( Index-1  ,0  >-Nearf leld< Index ,0  >  )*<  Thresho 

Id-Nearf leld< Index , I ) )/< Near field! Index- 1 ,1 )-Near field! Index  , I  ) ) 

5606  0ianeter*R2-Rt 

5608  OonesSUBENO 
5610  r 
5612  I 

5614  SUB  Fflaldvals! strings)  j 

5616  1 +*«#*•*##*##**#**♦#*»*♦*»***#••,*******♦***••••#*•»***»»»*»••*#»** •*»*«»»+ 

5618  !  FAR  FIELD  VALUES  SPECIFICATION!  MODULE  VERSION  2.1 

5620  !-*»**#*#*t#»»»»#»*»*t***«*»******##»**#»*»##»**»*«*»»* »*«♦«*•*»**»••*•»»- 

5622  COM  /Farfleld/  Ffleldval! •  )  ,Nuw_polnts ,Farf leld! ♦  )  ,Ff ielri.idS 

5624  COM  /Syscal/  Pin_x ,Pln_y ,Pin_2 .Inx^step , Iny_step ,0utx_step ,0uty_step  .Far 

f iBld_step .Lfnoise 

5626  Upper_li«“140*Farf ield_6tep  lUpper  limit  of  valid  farfield  values 

5628  Louer_lin*~550*Farf leld^step  ILouer  limit  of  valid  farfleld  values 

5630  1 

5632  I  The  array  builder  parses  the  user’s  input  string  and  builds  a 
5634  !  wavelength  array. 

5636  ! 

5838  CALL  Arraybui ld( String® .Ffieldval! »> ,Num_point5  ) 

5640  IF  Nu“,_pcints<0  THEN  lARRAYBUILD  got  an  error? 

5642  BEEP 

5644  OISP  "FFIELDVALS  —  Syntax  error  on  far-field  input  values  strino." 

5646  Deadi :60T0  Oeedl 
5648  END  IF 

5650  IF  Num_points>200  THEN  iChecl.  for  too  many  points 

5652  BEEP 

5654  OISP  "FFIELDVALS  —  More  than  200  values  are  specified.  Extras  will  be 

ignored." 

5656  WAIT  3 

5B58  Num_points=200  ISet  number  of  points  to  200 

5660  END  IF 

5662  ! 

5664  !  Now  check  to  see  if  the  values  are  all  within  the  valid  range 

5666  ! 

5668  FOR  lndex=0  TO  Num_points-t 

5670  IF  Ffieldval! Index )<-550*Farfield_5tep  THEN 

5672  BEEP 

5674  PRINT  TABXY! I  ,17 )| "FFIELDVALS  —  A  value  less  than  " iLower_l imi "  was 

specified." 

5676  PRINT  TAB>!Y!  1  ,18)|  "The  out-of-range  value  will  be  set  to  "sLower_lim 

5B78  wait  3 

5680  Ffleldval! Index )=-550*Farf leld_step 

5682  END  IF 

5R94  IF  Ffleldval! Indev  )>140»Farfleld  step  THEN 


5692  mu  5 

.  .  ^Fhirav4l<Inas>^  )«140*F«rfl#ld  step 

jffei;  •.  END  If 

SBlr  jNExt  indeR 
;S70?I.  ilSF  •“ 

’§702-  SOBENS 
S7®4:  I  : 

.,5706  I 

,57^8,  SUB  Ffi«ldrun(Ffwave .OPTIONAL  Runflag*) 

5712  !  FAR-FIELD  MEASUREHENTS  RUN  MODULE  VERSION  2.1 

5714  |-•»•«»•« *»••«•«•«••**««•«»««••••••«««««»*»***«»«« »*<»#»»«*»«««»»»*««#»»*#- 

5716  COM  /Farfield/  FfieldvaK * )  ,NuM_points  ,Farf ield< »  )  ,Ff ield_ld$ 

5718  COM  /Flbef/  Flber_ld$,Fiber_I«n,Log_tlme$ 

5720  COM  /Syscal/  Pin_x ,Pln_y .Pln^r ,Inx_step ,Iny„step  ,0ut>5_step ,0uty_5tep ,Far 
f i«ld_step .Lfnoise 

5722  COM  /Farfield^uave/  Ffuiavelen 

5724  INTE6ER  Index .Setting .Maas^range ,Runf lag 

5726  REAL  Sintheta  .Delta 

5728  Ffuavelen*Ffwave 

5730  IF  NPAR<2  THEN 

5732  Runflag*!  !  defaults  to  using  scanner  edge  if  not  specified 
5734  ELSE 

5736  IF  POS(Runflag*.“PIN" )  THEN 

5738  Runflaga0 

5740  ELSE 

5742  Runflag=1 

5744  END  IF 

5746  END  IF 

5748  OUTPUT  KBD  USING  "#.K"r‘K" 

5750  IF  Runflag  THEN 

5752  CALL  Rundisplayl "Far-f ield  Measurements  in  progress. 

(Using  scan 
ner  edge .  ) " ) 

5754  ELSE 

5756  CALL  Rundi5play< "Far — field  measurements  in  progress. 

(Using  pinh 
ole. )") 

5758  END  IF 

5780  I 

5762  I  Set  up  instruments  for  far  field  measurements 
5764  ! 

5766  CALL  Nextuave( Ffuave ) 

5768  CALL  F20008end( " INSB  LAMP  LAMP-ON  CHOP-ON  SPOT-OUT  XMIT  FF-IN") 

5770  CALL  F20005end( "UOUT  TARGET-OUT  0  ATTENUAT",!) 

5772  CALL  F2000send("FF  COUPL"  ) 

5774  CALL  FZ0005end( "-550  FAR-FIELD". 1)  I  eliminate  backlash 

5776  I 

5778  !  Measure  the  approx  peak  amplitude  and  fix  the  lock-in  voltmeter  scale. 

5780  ! 

5782  Reading*FNUoltMeter( . 1 ) 

5784  Peakval='2*Reading 

5786  CALL  Setscale( . 1  .Peakval ) 

5788  I 

5790  t  Take  the  measurements  at  each  specified  far-field  position 
5792  I 

5794  0elta=1.59  !  Positional  correction  of  edge  of  Far  Field  Scanner 

5796  !  (Actually  this  t  is  delta/focal„length.  delts-0.426! "  1 

5798  (  The  value  of  Delta  will  affect  hou  well  the  center  of 

5800  1  the  far*  field  plot  lines  up  with  the  peak  intensity  of 

5802  f  the  output  intensity  pattern. 

5804  CALL  RundisplayC 


:  V,; 


Si 


■iS#M. 

■MA 

5820 

'5822 

5824 

5828 

5828 

5830 

5832 

5834 

5836 

5838 

5840 

5842 

5844 

5846 

5848 

5850 

5852 

5854 

5856 

5858 

5860 

5862 

5864 

5366 

5868 

5870 

5872 

5874 

5876 

5878 

5880 

5882 

5884 

5886 

5888 

5390 

5892 

5894 

5896 

5898 

5900 

5902 

5904 

5906 

5908 

5910 

CO»7 


591 

5916 

5918 

5920 

5922 

5924 

5926 

5928 

5930 

5932 

5934 


II  i\uii  t  loy  1 1  ii-ii 

^  I  Sqinnar  #d§8  technique  i 

Siti  ings<  S  i  nthe  ie.'^Oe  He  )/Far  f  i  e  1  d_s  t  ep 
ftdiu'ei'tSett  l»ie*F«rf  leid^step+Oeita ) 

GfttL  F20@0tend<yALt( Set ting )&"  FAR-FIELO’M  > 
Reaidihg-FNVottweterl  .05) 

Ferf  ield(  Ihde)t ,  1  )**Readlng 
ELSE 
1 

I  Pinhole  technique 
!  Corrects  measurewent 


for  COSIPHI ) 


note  integer  truncation 
FAR-FIELD“  ,1 ) 


Setting*Sintheta/Farf leld_step 
Actual*SettinQ*Farf i6ld_step  I 
CALL  F20006end<VALt(SetiinQ>&" 

Reading=FNUoUneter(  .05) 

Farf ield( Index  ,  I )*Reading 
END  IF 

PRINT  Actual  .Reading 

1  The  folloulng  factor  of  ,873  is  a  calibration  factor.  It  uias  derived 
!  by  CQMparing  a  numerical  aperture  measurement  made  on  this  machine 
f  with  one  made  on  Ceorge  McCabe’s  NA  measurement  station.  The  fiber 
!  used  for  comparielon  was  900228  on  28  Mar  90. 

Farf lei d< Index ,0 )®Actual* .873 
NEXT  Index 

Ff ield_id$=Fiber_id*a,“  "8iLog_timei  iStore  the  fiber  ID  &  tine 

Farf ield<0  ,0  )=Num_points  lAlso  store  #  points  here  (for  ffieldplot) 

CALL  F20005end( "-550  FAR-FIELD"  )  IMove  scanner  bad'  down 

CALL  Cleardisplay 
SUBEND 
! 

! 

SUB  FfieldplotiOPTIONAL  Print_f  lag$ ,Mew_t i t le$  ) 

I  niiTOiiT  ftDADLiTre  Mnntiiir  cr\t3  c:An_cTtri  r\  OATTcnKi  nr-nf^rnM  t 


OUTPUT  GRAPHICS  MODULE  FOR  FAR-FIELD  PATTERN 


UERSIOM  2.1 


4  I 


I  This  module  is  responsible  for  both  plotting  and  printing  all  Far  Field 
!  data,  including  raw  data,  differentiated  data,  and  smoothed  data, 
t 

COM  /Farfield/  Ff  ieldvaK  •  >  ,Num_points  ,Farf  ield( »  >,  ,Ff  ield_id$ 

COM  /Fftempdata/  Ffrawdata( *  )  ,Ffdif fdata< *  )  .Ffsmoothdalal ♦  ) 

COM  /Farf ield_uave/  Ffwavelen 

! 

INTEGER  I, J, Index 

DIM  Title$C80],XlabelSC40] 

I 

1  Create  a  file  in  which  to  store  the  raw  data.  This  is  the  file  which 
I  is  loaded  back  into  the  Farfleld(»)  array  if  the  store,  option  is  chosen, 
!  Also  create  a  file  for  the  differentiate,  rough  (not  smoothed)  data. 
Either  t*!®  nr  rounh  data  can  be  smoothed. 


1 


IF  Print_flagf*"RAW  DATA"  THEN 
FOR  1=0  to  Farfleld(0,0) 

FOR  J=0  TO  I 

Ffraudatat I ,J )=Farf ield(  I ,J ) 

NEXT  J 
NEXT  I 
END  IF 

Compute  the  NA  for  differentiated  or  smoothed,  differentiated  data  only 
IF  Print_f.la§f="OlFF"  THEN 

f'Ai  I  I  "ntrr"  it.,™  \ 


:  ;;st4»v  ,  /  CAUL  Nunaper< -SHdOTH*  ,NUM_aper) 

WuS-tptF^,00r*lf!}T(  t000*Nuw  «per+.5 )  IRound  to  ^3  places 

J  i  ^/SiS2r-  -  I,  New  plot:  tH#  data, 

j? :  V" 

r|95B^#iotit£t 


sssr 

Xlabfllt-“SIMCiinole)’' 

^960' 

Far  Field  Pattern- 

'■'5962:- 

IF  NPAR>1  THEN  Tltle*-Neu  title* 

'5964 , 

SINIf 

5966 

eCLEAR 

5968 

SRAPHieS  ON 

SS70 

VIEWPORT  0,f00«RATIO.10.l00 

5972 

HCUE  0,95.5 

5974 

CSIZE  5 

5978' 

LABEL  Title* 

5978 

LABEL  "  ID:  -&Ffield_ldS 

5980 

Min«»-.3 

5982 

Ma>?s=,3 

5984 

Hlny=0 

5986 

Maxy®l 

5988 

Xsl2e“ABS(Maxx-Mlnx  > 

5990 

Yslze*ABS( Maxy-Mlny ) 

5992 

Botborder«Hlny-.2»Y3lze  !  Create  a 

graph  layout  with  space  for 

5994 

Topborder«Maxy+ . f *Ysi2e  !  labels 

5996 

Lef tborder»Mlnx-,2*Xsl ze 

5998 

Rgtborder=Maxx+ .05*X3lze 

6000 

UIEWPORT  0,100«RATIO,20,95 

6002 

WINDOW  Leftborder .Rgtborder .Botborder .Topborder 

6004 

! 

6006 

t  **  eenerato  the  frame  **. 

6008 

I 

60t0 

MOVE  Minx  ,Miny 

60f2 

IDRAW  Xsize.0 

B0t4 

IDRAW  0,Ysize 

60t6 

IMOVE  -Xslze,0 

6018 

IDRAW  0.-Ysize 

6020 

1 

6022 

1  **  Generate  the  graticule  lines  •* 

6024 

1 

6026 

LINE  TYPE  4 

IGraticule  in  dotted  lines 

6028 

FOR  lndex=0  TO  5 

•5  Vertical  divisions 

6030 

MOVE  Minx  ,Miny+< Ysize»lndex/5  ) 

6032 

IDRAW  Xsl2e.0 

iDrau  a  horizontal  line 

6034 

NEXT  Index 

•» 

6036 

FOR  lndex*0  TO  6 

•6  Horizontal  divisions 

6038 

MOVE  Minx+<X6ize*Index/G 1 ,Miny 

6040 

IDRAW  0,Ysize 

iPraw  a  vertical  line 

6042 

NEXT  Index 

6044 

LINE  TYPE  1 

iBack  to  solid  lines 

6046 

! 

6048 

1  **  Draw  the  graph  itself 

6050 

1 

6052 

IF  Pr.int^flag*«"RAW  DATA"  THEN 

6054 

MOVE  Ffrawdatat 1 ,0) ,Ffraudata< 1,1)  , 

605& 

FOR  Index*2  TO  Ffraudatal 0 ,0 ) 

6058 

DRAW  Ffrawdatat Index ,0 ) ,Ffrawdata( Index , 1 ) 

6060 

NEXT  Index 

6^2 

END  IF 

6064 

t 

6066 

IF  Print_f.lag*=-DIFF-  THEM 

- 

rnnq 

Mniif  r  f  ,Ji  f  f  ^  j  r  f  jJ:  f  f f  .-1 '  !  !  ) 

ij«.>  I  ■+  HUAI  illUU/, 

8078  ENO  IF 

8078  \ 

8080  IF  PrIrtt_fltgt»"SMOOTH"  THEN 

808?  MOVE  Ff««eothd«tfl< I ,0  >  ,Ff smoothdatal 1,1) 

6084  FOR  IndsH*?  TO  FTinoothdata<0 ,0) 

8088  DRAW  Ffsnoothdatal  Index  ,0)  ,Ffspioothdata<  Index  ,  I) 

6088  NEXT  Index 

6080  ENO  IF 

6092  f 

6094  I  *•  Put  in  the  X-axis  graticule  labels  ** 

6096  I 

6098  CSIZE  4 

8100  FOR  lndex*0  TO  6 

6102  Value»Minx+Index*Xsi2e/6  iConpute  the  value  of  the  label 

8104  MOVE  Value-. 09*X6ize,Hlny-.4*(Miny-Botborder) 

6106  LABEL  USIN6  "20.20“ jValue 

8108  NEXT  Index 

5110  ! 

6112  Xpos»Minx+X8l2e/2-LEN<Xlabel*  )•< X5i2e/40 >/2  ICompute  place  for  XLABELS 

6114  ! 

6116  1  *•  Print  the  X  label  string  »* 

6118  I 

6120  CSIZE  5 

6122  MOVE  Xpos .Botborder 

6124  LABEL  Xlabelt 

6126  j 

6128  I  **  Print  nunerical  aperture  value  ** 

6130  ! 

6132  WINDOW  0,100*RATr-,.l0,100 

6134  VIEWPORT  0,100*RATIO.10,100 

6136  MOVE  0,12 

6138  IF  Prlnt_flagS="0IFF"  OR  (Print_f  lag$»"SM00TH"  AND  Ff di  f  f data(  0  ,0  )•' •  0  1  THEM 
6140  IF  NuM_aper=0  THEN 

6142  LABEL  "  Numerical  Aperture  Not  Found." 

6144  ELSE 

6146  IF  Ffwavelen=-0  THEN 

6148  LABEL  USING  "  7X ,4A .D.DOD .3X , 1 3A  ,DDD0D  ,3A" i "NA  ="  ,Num_apor 

6150  ELSE 

6152  LABEL  USING  "7X  ,4A  ,D.DDD  ,3X  ,  I  3A  .DDDDD  .3A"  i  "NA  - "  ,Num_,-spcr  ,  "Uav-? 

length  ="  .Ffuiavelen  , "  nm“ 

6154  END  IF 

8156  END  IF 

6158  END  IF 

6160  I 

6162  I  The  rest  of  this  is  concerned  with  where  to  go  after  the  screen  plot. 
6164  Key_guy6:  I 

6166  I  Keys  which  appear  on  every  plot: 

6168  ON  KEY  1  LABEL  “  SMOOTH  DATA"  GOTO  Smooth 

6170  ON  KEY  2  LABEL  "DIFFER-  ENTIATE"  GOTO  Done 

6172  ON  KEY  4  LABEL  "  STORE  RAW  DATA"  GOTO  Storelt 

6174  ON  KEY  5  LABEL  "  EXIT"  GOTO  Exit_all 

6176  ON  KEY  7  LABEL  "  PRINT  LISTING"  GOTO  Prlnt_Ust 

6178  ON  KEY  8  LABEL  "  PRINT  PLOT"  GOTO  Print_plot 

6180  ! 

6182  Wait_key_guy8!0OTO  Wait_key_guys 
6184  t 

6186  ! - - - - 

6188  ! 

6190  Smooth:  OFF  KEY 

6192  PRINT  TABXYC 15,10)i"Smooth  the  RAW,  DIFFerent lated  or  SMOOTHED  data?" 
6194  ON  KEY  1  LABEL  "  RAW"  GOTO  Raw  smooth 


6204  Raw  smooth:  OFF  KEY 

6206  CALL  Ffg«ooth< "RAW  DATA") 

6206  Print  f l4Q**"SM0bTH" 

6210  SOTO  Plotit 

6212  0iff_8nQoths  OFF  KEY  »If  we  haven't  computed  diff  data,  then  do  that  first 
6214  IF  Ff£iiffdata<0,0)=0  THEN 

62!  8  PRINT 

6218  PRINT  OSINS  "5X  ,70A" t "Di f ferent ialed  data  has  not  been  calculated.  C 

an’t  be  smoothed  yet." 

6220  SOTO  Smooth 

6222  END  IF 

6224  CALL  Ffsmootht "DIFF"  ) 

6226  Print_flag$*"SKOOTH" 

6228  SUBEXn 

6230  Smoot h_snooth:  OFF  KEY 

6232  IF  Ff6moolhdatfl<0,0)*0  THEN 

6234  PRINT 

6236  PRINT  USING  "6X  ,70A" j "Smoothed  data  has  not  been  calculated.  Can’t  b 

e  smoothed  yet.  “ 

6238  GOTO  Smooth 

6240  END  IF 

6242  CAl  L  Ffsmootht "SMOOTH" > 

6244  Print_flag$»“SMOOTH" 

6246  SUBEXIT 

6248  ! 

6250  ! - - - 

6252  I 

6254  Storeit:  OFF  KEY 
6256  CALL  Cleardlsplay 

6258  CALL  Archive 

6260  GOTO  Plotit 

6262  I 

6264  t . . . . — . . . . . . 

6266  ! 

6268  Print.list:  OFF  KEY 

6270  PRINT  TABXY( 15. 10)? "Smooth  the  RAW,  DIFFerent iated  or  SMOOTHED  data?" 

6272  ON  KEY  1  LABEL  "  RAW"  GOTO  Prli!t_rau 

6274  ON  KEY  4  LABEL  "  DIFF"  GOTO  Print_dlff 

6276  ON  KEY  8  LABEL  "SMOOTHED"  GOTO  Prlnt_smooth 

6278  Nogo:  GOTO  Nogo 

6280  I 

6282  Pr int_rau:  OFF  KEY 
6284  PRINTER  IS  PRT 

6286  PRINT  "  Far  Field  Raw  Data  for  F Iber : "  ,F f 1  a ld_ld$ 

6288  PRINT 

6290  PRINT  USING  " 1 5X  ,48A" ; "Number  Scanner  Posit ioh  Normalised  Signal" 
6292  PRINT  "  " 

6294  FOR  1  =  1  ro  Ffrawdata< 0  ,0 ) 

6296  PRINT  USING  " I6X ,DDD  ,  10X  ,M.DDD  ,  tSX .MD .30" ? I  ,Ffrawdata< I  ,0  )  .Ffrawda ta< I  ,  1) 
6298  NEXT  I 

R300  PRINT  "  " 

6302  PRINTER  IS  CRT 

6304  GALL  Cleardlsplay 

6306  GOTO  Plotit 

6308  I 

63)0  Prlnt_diff;  OFF  KEY 

63)2  IF  Ffdlffdata(0,0)=0  THEN 

63)4  PRINT 

6316  PRINT  USING  "BX  ,70A" « "Di f ferent iated  data  has  not  been  calculated.  C 

an’t  be  printed  yet." 

63)8  GOTO  Print  list 

6320  END  IF 

nnjMTrp  tc  nnr 
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B330  PRINT  "  " 

6332  FOR  1*1  TO  Ffdiffdata<0,0) 

6334  PRINT  USIN8  " 1BX  .30 . 10X .M.30  .  t5X  .MD.3D“ » I  ,Ff di f f dat9< I  ,0 )  ,Ff di f f dataU  , !  ) 
6338  NEXT  I 

6338  PRINT  *  " 

8340  PRINTER  IS  CRT 

6342  CALL  Cleardt splay 

6344  60T0  Plot  it 

6346  ! 

6348  Print_':.'..o.-*th!  OFF  KEY 

8350  IF  -f  .foothdata<0,0)=0  THEN 

6352  PRINT 

6354  PRINT  USING  "6X  ,70A'‘ i  “SMOOthed  data  has  not  been  calculated.  Can't  b 

e  printed  yet. 

6356  GOTO  Print_list 

6358  END  IF 

8360  PRINTER  IS  PRT 

6362  PRINT  "  Far  Field  Swoothed  Data  for  Fiber: "  .Ffield  id$ 

5364  PRINT  "" 

6366  PRINT  USING  "  15X  ,48A’' i  "Number  Scanner  Position  Normalised  Signal" 

6368  PRINT  "  " 

8370  FOR  1*1  TO  Ff SMOOthdata(0  ,0 ) 

6372  PRINT  USING  " 1 6X  ,3D  ,  1 0X  .M.3D . 15X .MD . 3D" ; I  .Ff smoot hdata( I ,0  )  ,Ff smoothd 

ata( I  ,1  > 

6374  NEXT  I 

6376  PRINT  "  “ 

6378  PRINTER  IS  CRT 

6580  CALL  Cleardisplay 

6382  GOTO  Plotlt 

6384  1 

6386  I - - - - - - - . 

6388  I 

6390  Print.plot:  OFF  KEY 

6392  OUTPUT  KBD  USING  "#,K")"!" 

6394  DUMP  GR.APHICS 

6396  OUTPUT  KBD  USING 

6398  GOTO  Plotit 

6400  I 

6402  I - - - 

6404  I 

6406  Exit_all:  OFF  KEY 
6408  CALL  Menu 

6410  ! 

6412  Done:  OFF  KEY 

6414  IF  Print_f lag$=-"DIFF“  THEN 

6416  PRINT  "" 

6418  PRINT  "Sorry  to  deceive  you,  you  can’t  di  f  f  ercnt  late  thi-.  data." 

6420  GOTO  Plotit 

6422  END  IF 

6424  GCLEAR 

6426  GRAPHICS  OFF 

6428  SUBEND 


6430 

6432 

6434 

6436 

6438 

6440 

6442 

6444 

6446 


PUB  Nuinaper<  Print_f  lags  ,Nuin_aper  ) 


!  COMPUTE 
(-•»««•••• 
I  This  mod 
I  (present 


RICAL  APERTURE  MODULE  UEPSION  2.1 

calculates  the  fiber  NA  using  a  variable  threshold  method 
let  at  5%).  The  Input  data  set  may  either  be  the  rough 


f  * 

•  differentiated  data,  or  a  smoothed  version  of  the  same. 

I 

rnm  ^  r,Tpfio|d'*),Ffie 


uxi)  i-icauo  \  I  I  ! 


64S8  Threshold* .05  !Use  5%  threshold 

6460  ! 

6462  !  Fir^t  ,  determine  which  data  to  use  to  calculate  the  NA, 

6464  I 

6466  IF  Prlnt_flagS*"DIFF"  THEN 

8468  FOR  1*0  TO  Ffdi f fdata(0 .0 ) 

6470  FOR  J»0  TO  I 

6472  Nadata( I ,  J  )*Ffdl f fdata( I .J  ) 

6474  NEXT  J 

6476  NEXT  I 

6478  END  IF 

6480  I 

6482  IF  Print_flag$="SMOOTH"  THEN 

6484  FOR  1*0  TO  rfsnoothdata<0 .0  ) 

6486  FOR  J*0  TO  i 

6488  Nadata< I , J  )=Ff snoot hdata< I , J  ) 

6490  NEXT  J 

6492  NEXT  I 

6494  END  IF 

6496  ! 

6498  !  Next,  locate  the  15%  points  to  be  sure  we  are  off  the  noise  floor. 

6500  ! 

6502  Nun_aper*0 

6504  Indux*l 

6506  UHILE  Nadataandex  ,1  X.  15 

6508  Index*IndeX+ I 

6510  IF  Index>Nadata<0,0)  THEN  Done 

6512  END  WHILE 

6514  ! 

6516  I  Next,  search  backward  to  the  threshold  crossing, 

6518  I 

6520  WHILE  Nadata<Index,l  )>Threshold 

6522  Index*Inde.x-1 

6524  IF  Index<1  THEN  Done 

6526  END  WHILE 

6528  ! 

6530  1  Compute  a  crossing  using  linear  interpolation. 

6532  I 

6534  Sin1*Nadata(  Index ,0 )+(Nadata( Index  +  1 ,0 )-Nadata( Index  ,0  )  !*( Threshold-Nada 
ta(  Index  ,  1  >  l/I  Nadatal  Index  1  , 1  )-Nadata<  Index  ,  1  )  ) 

6536  I 

6538  I  Finally,  start  at  the  15%  level,  and  search  forward  to  the 
6540  I  next  interpolated  threshold  crossing., 

6542  I 

6544  IndBX*Index+1 

6546  WHILE  Nadatal Index  ,  I  >>Threshold 

6548  Index=Index+ 1 

6550  IF  Index>Nadat3<0,0)  THEN  Done 

6552  END  WHILE 

6554  Sin2*Nadata< Index ,0 )+<Nadata( Index-1 ,0 )-Nadata< InC3x  ,0  )  )*< 1 nrashold-Nada 

ta( Index , 1  )  )/<Nadata< Index-1  ,1 )-Nadata( Index , 1  )  ) 

6556  Nun„aper*SIN< (ASN<Sin2 )-ASN<Sin1 )>/2) 

6558  Done: SUBEND 
6560  I 
6562  I 

6564  SUB  Menu 

6566  I +♦*»*♦*•*••♦*•••*#•»»#*»»♦»••* •*#»♦»****♦♦*♦»***»♦#**»»«**»«*»♦»»*»»»»♦*  + 

6568  MENU  MODULE  UER6I0N  2. IP 

6570  •?.<*»»!.»»»»)- »»»»»»- 

6572  COM  /Addition/  Curr_uave ,Grat ings( « ) ,Cur_grat 1 ng  ,Wavc_s tep 

6574  DIM  MSI  1  :5 ,1  :8)E40]  ,K$(  I  :5 ,1  :8>n61  .Titleft  40] 

6576_ TNTF6FR  F  t  ■"si  .!.  as  t  .  Temn  *  variahlps  for  r.nlf*"f!nn  m- ■  r  j  pr..~iH  • 
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'  lilts  lu^iowiliy  ii'iayuii  ...  t.  i  ui  i  _  . 

SB86  I 

S588  Headirtage s IMAGE  14X , "KEY"  ,9X  ."FUNCTION"  iHeadings  (underlined) 

BS90  KeyiMagS!  IMAGE  UX  , "  f "  ,D  .  10X  ,40A  lUnshifted  l-eys 

GB92  f 

SB94  ! - 

BBBG  ! - 

8B98  ! 

BS00  IThe  fallowing  data  statments  are  for  the  nenu  prompts. 

6602  ! 

ee04  I - 

6606  I 

6608  I  FIRST  MENU 

6610  ! 

6612  DATA  RUN  FIBER  TESTS  .PRINT  PROGRAM  LISTING  .EXAMINE  SYSTEM  DATA .EQUIPMENT 
PRE-SET 

6614  DATA  Set  Time  and  Date, Save  Results  ( ARCHIUE  )  .Retrieve  Archived  Data. Res 
tart  Program 
6616  I 

6618  ! - 

6620  I 

6622  I  SECOND  MENU 

6624  I 

6626  DATA  RETURN  TO  MAIN  MENU, LOAD  FIBER  AND  IDENTIFY  .FIBER  INPUT  ALIGN. FIBER 
OUTPUT  ALIGN 

6628  DATA  Fiber  Test  1:  SPECTRAL  ATTENUATION  .Fiber  Test  2:  DIFFERENTIAL  M 

ODAL  ATTEN .Fiber  Test  3/4:  FAR  FIELD  (edge/pinhole) 

6630  DATA  Fiber  Test  5:  NEAR  FIELD  (Inactive) 

6632  ! 

6634  ! - - - 

6636  I 

6638  !  THIRD  MENU 

6640  ! 

6642  DATA  RETURN  TO  MAIN  MENU  .RETURN  TO  FIBER  TEST  MENU, LOAD  FIBER  AND  IDENTI 
FY  .Run  FAR  FIELD-pinhole  (low  loss  fiber) 

6644  DATA  Run  FAR  FIELO-edge  (higher  loss  fiber )  .Recall  data  from  previous  te 
St , not  used, hot  used 
6646  ! 

6648  I - 

G6B0  ! 

6652  !  FOURTH  MENU 

6654  ! 

6656  DATA  "  RETURN  TO  MAIN  MENU","  800  nm  to  1800  nm  (Grating  1  )" 

6658  DATA  “1800  nm  to  2700  nm  (Grating  2)", "2700  nm  to  4000  nm  (Grating  3)" 

6660  DATA  “800  nm  to  4000  nm  (Full  Spectral  Range  )",  “Rccal 1  data  from  previou 
s  test" 

6662  DATA  "Change  wavelength  stepping  increment ",  "Enter  your  own  wavelength  r 
ange" 

6684  I 

6666  I - 

6668  ! 

6670  i  FIFTH  riENU 

6672  t 

6674  DATA  "  RETURN  TO  MAIN  MENU","  800  nm  to  1800  nm  (Grating  I  )" 

6676  DATA  "1800  nm  to  2700  nm  (Grating  2) ","2700  nm  to  4000  nm  (Grating  3)" 

6678  DATA  "800  nm  to  4000  nm  (Full  Spectral  Range  )", "Recal  1  data  from  previou 

s  test" 

6680  DATA  "Change  wavelength  stepping  increment ",  "Enter  your  own  wavelength  r 

^6682  READ  MS(*)  Cf  't  -- 

6684  I 

6686  ! -  - 

4  6688  I - - - 
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i 


OdtJD  !  tilf  ts  Ut  utiu  pvai  iionw  < 

B698  ! 

B700  - - 

B702  ! - - - 

6704  ! 

6706  1  FIRST  MENU  KEY  LABELS,  9817  MAIN  MENU 

6708  I 

B7t0  0atat7:  DATA  "  FIBER  TESTS"  .PROGRAM  LISTING  .SYSTEM  DATA, PRESET  EQUIPMN 
T,SET  TIMES  DATE .ARCHIUE  .RETRIEUE ."RESTART  PROGRAM" 

6712  t 

6714  t - ^ - 

6716  ! 

6718  !  SECOND  MENU  KEY  LABELS.  981?  FIBER  TESTS  MENU 

6720  I 

6722  DATA  "  MAIN  MENU","  LOAD  FIBER","  INPUT  ALIGN","  OUTPUT  ALIGN" 

.SPECTRAL  ATTEN.DIF  MODE  ATTEN,"  FAR  FIELD", "NEAR  FLDINACTIVE" 

GV24  t 

G72G  I - 

6728  ! 

6730  I  THIRD  MENU  KEY  LABELS,  9817  FAR  FIELD  MENU 

6732  I 

6734  DATA"  MAIN  MENU","  TEST  MENU","  LOAD  FIBER" , "PIN  H0LE( s i 1 ica 

)","  EDGE  (usual)","  RECALL  DATA","","" 

6736  ! 

6738  I - 

6740  I 

6742  !  FOURTH  MENU  KEY  LABELS.  9817  DMA  MENU 

6744  ! 

6746  DATA"  MAIN  MENU" .GRATING  I .GRATING  2, GRATING  3, GRATINGS  1/ 

2/3,"  RECALL  DATA" .UAUELEN  STEP."  USER  DEFINED” 

6748  t 

B750  I . . - - - 

6752  I 

6754  !  FIFTH  MENU  KEY  LABELS,  9817  SPECTRAL  ATTENUATION  MENU 

6756  ! 

6758  DATA"  MAIN  MENU" .GRATING  I .GRATING  2, GRATING  3, GRATINGS  1/ 

2/3,"  RECALL  DATA" .WAUELEN  STEP,"  USER  DEFINED" 

6760  I 

6762  ! - - - 


f 

I 


I 

I 


6764  ! 


6766  STATUS  K8D,9iKey_id  iDeternine  tlial  the  computer 
6768  IF  BIT(Key_id,5)  THEN  RESTORE  DatsI?  r 
6770  REA0K$<O  I-  ■.  ' 

6772  GOSUB  Clr_screen  ^ 

6774  ! 

6776  !  The  following  section  creates  the  various  menus. 

6778  I 


6780  Menu_l  ;Merui._num- 1 

6782  Title$="NRL  IR  FIBER  CHARACTERIZATION  SYSTEM 

6784  Curr  wave  step=Wave  step 


6785 

GO= 

il'B  Draw„boxl 

6788 

BEEP 

6790 

ALPHA  ON 

6792 

GRAPHICS 

ON 

6794 

ON 

KEY 

0 

LABEL 

""  GOTO 

6796 

ON 

KEY 

1 

LABEL 

K*<  1 

6798 

ON 

KEY 

2 

LABEL 

K*(  1 

.2) 

6800 

ON 

KEY 

3 

LABEL 

KS(  1 

.3) 

6802 

ON 

KEY 

4 

LABEL 

K*(  1 

.4) 

6804 

ON 

KEY 

5 

LABEL 

Ki(  I 

,S) 

6806 

ON 

KEY 

6 

LABEL 

KS(  1 

,6) 

6808 

ON 

KEY 

♦ 

LABEL 

KVCl 

.7) 

6810 

ON 

KEY 

8 

LABEL 

K*<  1 

,9) 

'•  I 

r>»  1 

t'CV 

CJ 

1  ADr! 

rnrn 

•Draw  the  menu  picture 


Update_t ime 
GOTO  KQyI_I 
GOTO  Keyl_2 
GOTO  Keyl_3 
GOTO  Key)_4 
GOTO  Key  1.5 
GOTO  Kuyl„6 
GOTO  Keyl_7 
GOTO  Key1_8 


is  jn  fact 


the  0817 


4  4  ^ 


Oulu  upua Lu_i. iiMti 


8820  I 

8822  Manu_2:Titi«$*"  FIBER  TEST  MENU" 

6824  Menu_fiu«s2 

6826  GOSUB  Orau_box2  (Draw  the  nenu  picture 

6828  BEEP 

6830  ALPHA  ON 

6832  GRAPHICS  ON 

6834  ON  KEY  0  LABEL  ""  GOTO  Update_time 

6836  ON  KEY  1  LABEL  K$<2,l)  GOTO  Key2_1 

6838  ON  KEY  2  LABEL  K«(2,2)  GOTO  Key2_2 

6840  ON  KEY  3  LABEL  K$(2,3)  GOTO  KBy2_3 

6842  ON  KEY  4  LABEL  K$<2,4)  GOTO  Key2_4 

6844  ON  KEY  5  LABEL  K$(2.5)  GOTO  Key2_5 

6846  ON  KEY  6  LABEL  K*<2.6)  GOTO  Key2_G 

6848  ON  KEY  7  LABEL  K*(2.7)  GOTO  Kay2_7 

6850  ON  KEY  8  LABEL  K$<2,8)  GOTO  Key2_8 

6852  ON  KEY  9  LABEL  ""  GOTO  Update_tiMe 

6854  GOTO  Update_tlne 
6856  I 

6858  Menu_3:  Titl€®=''FAR  FIELD  MENU" 

6860  Menu_nurt=3 

6862  GOSUB  Draw_bo>?3 

6864  BEEP 

6866  ALPHA  ON 

6868  GRAPHICS  ON 

8870  ON  KEY  0  LABEL  ""  GOTO  Update_time 

6872  ON  KEY  1  LABEL  K$<3.l)  GOTO  Key3_l 

6874  ON  KEY  2  LABEL  K*<3,2)  GOTO  Key3_2 

6876  ON  KEY  3  LABEL  K$<3.3)  GOTO  Key3_3 

6878  ON  KEY  4  LABEL  K$<3,4)  GOTO  Key3_4 

6880  ON  KEY  5  LABEL  K$<3,S)  GOTO  Key3_S 

6882  ON  KEY  6  LABEL  K$<3,6)  GOTO  Key3_G 

6884  ON  KEY  7  LABEL  K«(3,7)  GOTO  Key3_7 

8386  ON  KEY  8  LABEL  K$(3,8)  GOTO  Key3_8 

6388  ON  KEY  9  LABEL  ""  GOTO  Update_tlwe 

6890  GOTO  Update_tine 
6892  ! 

6394  Menu_4:  Ti t le*=’'DIFFERENTIAL  MODAL  ATTENUATION" 

6896  Menu_num=4 

6898  GOSUB  Draw_box4 

6900  PRINT 

6902  PRINT 

6904  PRINT  USING  "26X  ,28A  ,50  ,3A" j "Current  Wavelength  step  is : " ,Curr_wave_step 
nn" 

6906  BEEP 

6908  ALPHA  ON 

6910  GRAPHICS  ON 

6912  ON  KEY  0  LABEL  ""  GOTO  Update_tlme 

6914  ON  KEY  1  LABEL  K$(4.1)  GOTO  Key4_l 

8916  ON  KEY  2  LABEL  K$(4,2)  GOTO  Key4_2 

6918  ON  KEY  3  LABEL  K$(4,3)  GOTO  Key4_3 

6920  ON  KEY  4  LABEL  K*<4,4)  GOTO  Key4_4 

6922  ON  KEY  S  LABEL  K$<4,5)  GOTO  Key4_S 

6924  ON  KEY  6  LABEL  K$<4,G)  GOTO  Key4_6 

6926  ON  KEY  7  LABEL  K*<4,7)  GOTO  Key4_7 

6928  ON  KEY  8  LABEL  H*<4,8)  GOTO  Key4_.8 

8930  ON  KEY  9  LABEL  ""  GOTO  Update_time 

6932  GOTO  Update_tlne 

6934  I 

6936  Menu_5:  Tt t SPECTRAL  ATTENUATION  MENU" 

6938  Menu  num=S 


6950 

6952 

6954 

6956 

6958 

6960 

6962 

6964 

6966 

6968 

6970 

6972 

6974 

6976 

6978 

6980 

6982 

6984 

6986 

6988 

6990 

6992 

6994 

6996 

6998 

7000 

7002 

7004 

7006 

7008 

7010 

7012 

7014 

7016 

7018 

7020 

7022 

7024 

7026 

7028 

7030 

7032 

7034 

7036 

7038 

7040 

7042 

7044 

7046 

7048 

7050 

7052 

7054 

7056 

7058 

7060 

7062 

7064 

7066 

7068 

7070 


ALPHA  ON 
GRAPHICS  ON 

ON  KEY  0  LABEL  ""  GOTO  Updat6_tine 
ON  KEY  1  LABEL  K$<5.1)  GOTO  KeyS  1 
ON  KEY  2  LABEL  K*(5.2)  GOTO  KayS_2 
ON  KEY  3  LABEL  K*(S,3)  GOTO  Key5_3 
ON  KEY  4  LABEL  Kf(S,4)  GOTO  Key5_4 
ON  KEY  5  LABEL  Kt<5,5>  GOTO  KeySls 
ON  KEY  6  LABEL  K*(5,G)  GOTO  Key5_6 
ON  KEY  7  LABEL  K$<5,7)  GOTO  Key5_7 
ON  KEY  8  LABEL  K$(5.8)  GOTO  Key5_8 
ON  KEY  9  LABEL  ""  GOTO  Update_time 
GOTO  Updat6_ti!ne 

I 

1  A  key  press  from  any  menu  causes  the  program  to  branch  to  a  point  below: 
I 

(First  menu  branches. 

Keyl_1 sGOSUB  Clr_soreen 

GOTO  Menu_2  l  Go  to  the  next  menu 

Keyl_2:GOSUB  Clr_screen 

CALL  Proglist  i  Examine  serial  number 

GOTO  Menu_l  i  Go  nowhere,  and  fast 

Keyl_3:G0SUB  Cir_screen 

CALL  Systemdata  l  Examine/modify  system  data 

CALL  Serialno 
GOTO  Menu_l 

Key1_4:G0SUB  Cir_screen 

CALL  Preset  !  Pre-set  the  system  equipment 

GOTO  Menu_1 

Keyl_55G0SU8  Clr_screen 

CALL  Timeset  •  •  Sat  the  time  and  date 

GOTO  tienu.l 

Key 1_6 :60SU8  Clr_screen 

CALL  Archive  •  Archive  test  results 

GOTO  Menu_l 

Keyl_7*.G0SUB  Clr_6creen 

CALL  Retrieve  !  Retrieve  archived  test  results 

GOTO  Menu_1 

Keyl_8:60SUB  Clr_screen 

GOTO  Done  i  Esclt  MAINPROG 

GOTO  Menu  1 


! Second  menu  branches. 

Key2_l:G0SUB  Cir_screen 
GOTO  Menu.l 

Key2_2:60SUB  Clh_screen 
CALL  FibertestG 
GOTO  Menu_2 

Kev2  3j60SUB  Clr  screen 
CALL  Inalign 
GOTO  MenU_2 

Key2_4!60SUB  Clr_scrcen 
CALL  Outalign 
GOTO  Menu_2 

Key2_5s60SUB  Clr_8creen 
GOSUB  Menu_5 

Key2_6:G0SUB  Clh_screen 
GOSUB  Henu_4 

Key2_7!  GOSUB  Clr_screBn 
GOTO  Henu_3 

Key2_8:G0SUB  Clr  screen 


!  Pre-set  the  system  equipment 


•  Sat  the  time  and  date 


I  Archive  test  results 


!  Retrieve  archived  test  results 


I  Esclt  MAINPROG 


!  Return  tti  main  menu 

•  Run  Fiberload  routine 

•  Return  to  Fiber  Test  menu 

!  Align  input  fiber  end 

•  Return  to  Fiber  Test  menu 

!  Align  output  fiber  end 
!  Return  to  Fiber  Test  menu 

I  Go  to  Spectral  Attenuation  menu 

!  Go  to  DMA  menu 

•  Go  to  Far  Field  menu 


»  «  u 


‘  U  ilCMU  Ul 

7080  Key3_l sGOSUB  Clr  screen 

7082  GOTO  Henu^l 

7084  Key3_2!60SUB  Clr_screen 

7086  GOTO  Menu_2 

7088  Key3_3:G0SUB  Clr__SGreen 

7090  CALL  FibertestB 

7092  GOTO  MenU_3 

7094  Key3_4!G0SUB  Clr_sereen 

709G  CALL  Fiberte8t4 

7098  GOTO  Msnu_3 

7100  Kty3_S:G0SUB  Clr_screen 

7102  CALL  Flbert€st3<0) 

7104  GOTO  M€nu_3 

7106  Key3_6:G0SUB  Clr_screen 

7108  Source_f lag=FNDatasource 

7110  CALL  Cleardisplay 

7112  CALL  Fibertest3< Source  flag) 

7114  GOTO  I1enu_3 

7116  Key3_7:GOSUB  Cir_screen 

7118  GOTO  Menu_3 

7120  Key3_8:G0SU8  Clr.screen 

7122  GOTO  Menu  3 


Return  to  main  wenu 


I  Run  Fiberload  routine 


Run  Far  Field  (pinhole) 


I  Run  Far  Field  (edge)(0~new  test) 
•Retrieve  data 

•First  determine  data  source 
•Clear  data  query  from  screen 
•Review  past  data 


new  test 


7126  •Fourth  menu  branches. 

7128  Key4_iJ  GOSUB  Clr_screen  iReturn  to  main  menu 

7130  GOTO  Menu.l 

7132  Key4_2:  GOSUB  Clr_screen  ISelect  this  wavelength  range  for  next  DMA  test 
7134  Specwaves( "800  TO  1798  STEP  "&UAL$( Curr_wave_6tep  ) ) 

7136  CALL  Fiberlest2< 0)  ! Source_f lag=0i  run  new  test 

7138  GOTO  Menu_4 

7140  Key4_3J  GOSUB  Clr_8creen 

7142  Specuavesi "1800  TO  2698  STEP  "&UAL$< Curr_wave_step  ) ) 

7144  CALL  FibertestZ< 0 )  !Sourc6_f lag=0i  new  test 

7146  GOTO  Menu_4 

7148  Key4_4:  GOSUB  Clr_Screen 

7150  Specwaves(  “2700  TO  4000  STEP  "&l^)ALS(  Curr_wave_step  ) ) 

7152  CALL  Fibertest2( 0 )  ISource  flag=0;  new  test 

7154  GOTO  Menu_4 

7156  Key4_5:  GOSUB  Clr_screen 

7158  Specwave5< "800  TO  4000  STEP  ”&UAL$(  Curr_wave_step  ) ) 

7160  CALL  Fibertest2< 0 )  •Source_f lag=0i  new  test 

7162  GOTO  Menu_4 

7164  Key4_G!  GOSUB  Clr_screen  • Retrieve  data 

7166  Source_f lag^FNDatasource  •First  determine  data  source 

7168  CALL  Cleardisplay  iClear  data  query  from  screen 

7170  CALL  FlbertestZi Source_f lag )  iReview  data  from  within  test 

7172  RETURN 

7174  Key4_7;  GOSUB  Clr_screen 

7176  Curr_uave_step®FNGetint( "Enter  new  wavelength  stepping  increment  (20-200 

):  ",10,200) 

7178  GOSUB  Clr_8creen 

7180  GOTO  Menu_4 

7182  Key4_8!  GOSUB  Clr_screen 

7184  First=FN6etint< "Enter  First  Wavelength  (600-4000  nm>:  ”,600,4000) 

7186  Last*FNGet int( "Enter  Last  Wavelength  (600-4000  nm):  ",600,4000) 

7188  IF  La8t<First  THEN 

7190  Teinp=FirSt 

7192  First*Last 

7194  Last*Temp 

7196  END  IF 

7198  Specwaves(UALf(Fir3t  )&"  TO  "&UALf ( Last  )&"  STEP  "8,UALT.( Curr_w3ve„;. tep  ) ) 

I 


leniMi 


iReturn  to  main  menu 


72!0  Keys  t!  CALL  Cieardisplay 
7212  SOTO  «iriu_) 

7214  —  RETURN 

7216  K6y5_2:  CALL  ClaardispUy  iWavelenqth  ranqe  for  ne>  t  test 

7218  Spscwavast *800  TO  1798  STEP  "SUAL*( Curr_wave_step  )  ) 

7220  CALL  Fibartest 1 < 0 )  i Source_f lag=0?  run  new  test 

7222  SOTO  HenU_S 

7224  KeyB_3:  CALL  Cieardisplay 

7226  Specuavest "1800  TO  2698  STEP  "SUAL^t Curr_wave_5tep  ) ) 

7228  CALL  Flbertest  1  <  0 )  !  Source_f  lag=f0i  new  test 

7230  SOTO  Hanu_5 

7232  Key5_4:  CALL  Cieardisplay 

7234  Specwavest "2700  TO  4000  STEP  "&UAL*( Curr_wave_step ) ) 

7236  CALL  Flbertest *( 0 )  !Source_f lag=0i  new  test 

7238  GOTO  Menu_S 

7240  KeyS_5!  CALL  Cieardisplay 

7242  Specuavest  “800  TO  4000  STEP  "!iUAL$(  Curr_wave_step  ) ) 

7244  CALL  Flbertest  H0)  ! Source_f  lag=^0?  new  test 

7246  GOTO  Menu_5 

7248  KeyB_6:  CALL  Cieardisplay  iRetrieve  data 

7250  Source_f lag*FNData50urce  IFirst  deternlne  the  source 

7252  CALL  Cieardisplay  IClear  data  query  from  screen 

7254  CALL  Flbertest I ( Source_f lag )  iRevieu  data  from  within  test 

^7256  RETURN  I  ’  v..'W^r 

7259  Key5_7:  CALL  Cieardisplay 

7260  Curr_wave_step»FNGetlnt( "Enter  new  wavelength  stepping  increment  <20-200 

);  ",10,200)" 

7262  CALL  Cieardisplay 

7264  GOTO  Menu_5 

7266  Key5_8!  CALL  Cieardisplay 

7268  First*FNGetint< "Enter  First  Wavelength  (600-4000  nm);  ",600,4000) 

7270  Last=FNGetlnt< "Enter  Last  Wavelength  <600-4000  nm):  ",600,4000) 

7272  IF  Last<First  THEN 

7274  Tenp^Flrst 

7276  First*Last 

7278  La6t=Temp 

7280  END  IF 

7282  Specwavesl  UAL$<  First  )&"  TO  "8.UAL$<  Last  )& "  STEP  "S.UAL$<  Curr_wave_step  )  > 
7284  CALL  Cieardisplay 

7286  CALL  Flbertest 1  i Source_f lag^0;  new  test 

7288  GOTO  Menu_5 

7290  I 

7292  !  This  part  of  the  subroutine  clears  the  screen: 

7294  I 

7296  Clr .screen;  ! 

7298  OFF  KEY 

7300  DISP  "  " 

7302  OUTPUT  KBO  USING 

7304  6CLEAH 

7306  RETURN 

7308  I 

7310  !  This  part  of  subroutine  prints  the  current  t*me  and  date  on  the  menu; 

7312  ! 

7314  Update_t Ime:Date$=FNT imedate* 

7316  CONTROL  CRT,  1 »5 

7318  CONTROL  CRT,0f65  f 

7320  OUTPUT  CRT iDatetl 1  ,POS(Date$,"  ")] 

7322  CONTROL  CRT,  1 |6 

7324  CONTROL  CRT,0i65 

7326  OUTPUT  CRTiOate$[PQS<Oate*  ,"  "  )^1 ,LEN< Oatef  )  1 
7328  GOTO  Update  time 


7340  WINDOW  0,I0@*RATIO  ,0,100 

7342  FOR  O«lta*0  TO  .8  STEP  .8 

7344  MOVE  Delia*RATIO/1 .3 .12+Delta 

7346  DRAW  0«lt«*RRTI0/1  .3,92-OeHa 

7348  DRAW  t0*RATIO/ 1 .3  ,92-D«lta 

7350  IMOUE  0,-3 

7352  I DRAW  0,8 

7354  lORAW  It 1*RATIO/l .3,0 

7356  I ORAM  0,-8 

7358  lORAW  -in *RATIO/ 1.3,0 

7360  MOVE  12HRATIO/1 .3,92-DeUa 

7362  DRAW  n30-DeUa  )*RATI0/1  .3 ,92-Delta 

7364  DRAW  <  130-DsUa  )*RATIO/l  .3 . 12+Dalta 

7366  DRAW  Delta*RATIO/l .3 .12+Delta 

7368  NEXT  Delta 

7370  CSIZE  5. .60 

7372  FOR  Delta»0  TO  .3  STEP  .2 

7374  MOVE  10.5*RATIO/ 1 .3  ,90 

7376  IMOVE  Delta»RATIO/l .3,0 

7378  LABEL  Tltle$ 

7380  NEXT  Delta 

7382  !  Tine,  date,  and  title: 

7384  CONTROL  CRT,  ns 

7386  CONTROL  CRT,0i59 

7388  OUTPUT  CRT? “DATE:" 

7390  CONTROL  CRT,  ns 

7392  CONTROL  CRT,0?59 

7394  OUTPUT  CRT {"TIME:" 

7396  CONTROL  CRT, n 7 

7398  OUTPUT  CRT  USING  Headlnage 

7400  CONTROL  CRT,  n 9 

7402  GOTO  Bo)i;_end 

7404  ! 

7406  Dra(ij_box2:  iDrau  background  for  Fiber  Tests  Menu 

7408  gTnIT 

7410  WINDOW  0,t00»RATIO. 0,100 

7412  FOR  Delta*0  TO  .8  STEP  .8 

7414  MOVE  Delta*RATIO/1 .3,1Z+Delta 

7416  DRAW  Delta*RATIO/1 .3,g2-Delta 

7418  DRAW  40*RATIO/1 .3,92-Delta 

7420  IMOVE  0,-3 

7422  IDRAW  0,8 

7424  IDRAW  50»RATIO/1  .3,0 

7426  IDRAW  0,-8 

7428  IDRAW  -50*RATIO/1  .3,0 

7430  MOVE  90»RATIO/ I .3,92-Delta 

7432  DRAW  <1  30-Del ta  )»RATIO/ 1 .3  ,32-Del ta 

7434  DRAW  <1  30-Del ta  )»RATIO/ 1 . 3 , 1 2+Del ta 

7436  DRAW  Del ta*RATIO/ 1 .3 , 1 2+Del ta 

743B  next  Delta 

7440  FOR  Delta«0  TO  .3  STEP  .05 

7442  CSIZE  7 

7444  MOVE  0,93 

7446  IMOVE  Delta*RATIO/l .3,Delta 

7448  LABEL  "FOA-2@00" 


CSIZE  4 
MOVE  95,93 

IMOVE  Oelta*RATIO/1 .3,Oelta/t0 
LABEL  "PK  -  VPI" 

NEXT  Delta 
CSIZE  B,.S8 

FOR  Oelta=0  TO  .3  STEP  .2 


t  U  W  4.  V  U1 

I  Tiwe,  daifj,  and  title: 

CONTROL  CRT.liS 
CONTROL  CRT,0j59 
OUTPUT  CRT? "DATE:" 

CONTROL  CRT.f  ?S 
CONTROL  CRT  .0159 
OUTPUT  CRT; “TIME 
CONTROL  CRT.1?7 
OUTPUT  CRT  USING  Headltnage 
CONTROL  CRT  ,  1 ?  9 
GOTO  Bo>!_end 

! 

7496  Draw^boxS:  iDraw  background  for  Far  Field  menu 

7498  GINIT 

7500  WINDOW  0.t00*RATIO,0,t00 
7S0Z  FOR  Delta=0  TO  .8  STEP  .8 

7504  MOUE  Oelta*RATIO/1 .3,12+Delta 

7506  DRAW  Del ta*RATIO/ 1 . 3  .92-Delta 

7508  DRAW  42*RATIO/ I .3.92-Delta 

7510  IMOUE  0,-3 

7512  IDRAW  0.8 

7514  IDRAW  48*RATI0/1 .3.0 

7516  IDRAW  0.-8 

7518  IDRAW  -48»RATI0/1  .3  .0 

7520  MOUE  90*RATIO/1 .3,92-Deita 

7522  DRAW  n30“Delta  )*RATIO/l  .3  .92-Delta 

7524  DRAW  < 1 30-Delta  )*RATIO/ 1 .3 ,1 2+Delta 

7526  DRAW  Delta*RATIO/ 1 .3 , 1 2+Del ta 

7528  NEXT  Delta 

7530  CSIZE  5,. 58 

7532  FOR  Delta»0  TO  .3  STEP  .2 

7534  MOUE  45.0*RATIO/1 .3  .90 

7536  IMOUE  Delta*RATIO/l .3  ,0 

7538  LABEL  Titles 

7540  NEXT  Delta 

7542  I  Tine,  date,  and  title: 

7544  CONTROL  CRT  ,1 55 

7546  CONTROL  CRT. 0:59 

7548  OUTPUT  CRT; "DATE:" 

7550  CONTROL  CRT,1?G 

7552  CONTROL  CRT, 0; 59 

7554  OUTPUT  CRT; "TIME:" 

7556  CONTROL  CRT,  1 58 

7558  OUTPUT  CRT  USING  Headltnage 

7560  CONTROL  CRT,  1  ;8 

7562  GOTO  Box_end 

7564  I 

7566  Oraw_box4:  'Orau  background  Tor  DMA  menu 

7568  GINIT 

7570  WiriOOW  0,100*RATIO,0,100 

7572  FOR  Deita=0  10  .8  STEP  .8 

7574  MOUE  Oelta»RATIO/ 1 .3 , 1 2+Delta 

7576  DRAW  Oelta*RATIO/l .3 ,92-Delta 

7578  DRAW  20*RATIO/1 .3,92-Oelta 

7580  IMOUE  0,-3 

7582  IDRAW  0,8 

7584  IDRAW  95*RATI0/1 .3,0 

7586  IDRAW  0.-8 

7588  IDRAW  -95»RATI0/1 .3 .0 

7590  MOUE  1 15*RATI0/1 .3,92-Oelta 

7592  DRAW  < t30-Delta  )»RATI0/1 .3 ,92-Del ta  iDrau  to  right  edge  of  oct rcn 

7594  DRAW  ( 130-Del ta  )»RATI0/1 .3 , 12+Del ta  'Draw  down  right  nidc  of  o^reen 

'.f-r.r-  (  ;i/-  1  1  .  r'AT  t  o  /  f  "•  I  ">  I  tin  !  ;  T  >  ft,  . .  ,  1  n  f  •  t  ■  ’  '  I  ..  t  I  ■  ■  r 


iGo  to  lower  left  corner  of  screen 
•Draw  line  up  left  side  of  screen 
•  Draw  right,  towards  middle, top 
IMove  down  a  bit 
•Draw  up,  1.  side  of  label  box' 
IDraw  right,  over  menu  label 
•Draw  down,  r.  side  of  label  box 
•Draw  left,  under  menu  label 
IMove  to  center /right  of  label  box 


r  “t-  ('Ll 

7472 

7474 

7476 

7478 

7480 

7482 

7484 

7486 

7488 

7490 

7492 

7434 


> 


i  u(\  utsiiiu  V  iw  •w 

MOUE  24.0*RATIO/! .3.90 
IMOUE  D«14a*RATIO/J.3,0 
LABEL  Titl«t 
NEXT  0«lta 


I  Move  to  where 


a 

S  r 

1  ll 

7614 

CONTROL  CRT.hS 

7616 

CONTROL  CRT.0tS9 

7618 

OUTPUT  CRT r DATE:" 

0 

7620 

CONTROL  CRT,1|6 

1  fi 

7622 

CONTROL  CRT,0t59 

1 

7624 

OUTPUT  CRT r TIME;" 

li 

•3 

7626 

CONTROL  CRT.I jG 

7628 

OUTPUT  CRT  USING  Head image 

1 

7630 

CONTROL  CRT.I18 

1 
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GOTO  Box‘_and 
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Draw_box5:  IDraw  background  for  Spectral 

6INIT 

WINDOW  0,I00»RATIO,0,I08 
FOR  Oelta=0  TO  .8  STEP  .8 

MOUE  Delta»RATIO/l .3.12+Delta 
DRAW  Delta*RATIO/ I .3.92-Delta 
DRAW  25*RATI0/1 .3,92-Delta 
IMOUE  0,-3 
IDRAW  0,8 

IDRAW  77*RATI0/I  .3,0 
IDRAW  0,-8 

IDRAW  -77»RATI0/I .3.0 
MOUE  102*RATIO/!. 3, 92-Delta 
DRAW  < l30-Delta)«RATIO/l .3,92-Delta 
DRAW  < 130-Delta)*RATIO/1 .3,12+Delta 
DRAW  Oelta*RATIO/t. 3,12+Delta 
NEXT  Delta 
CSIZE  5, .58 

FOR  Delta=0  TO  .3  STEP  .2 
MOUE  26.5»RATI0/1 .3,90 
IMOUE  Delta»RA7I0/I .3.0 
LABEL  Titles 
NEXT  Delta 

!  Tine,  date,  and  title: 

CONTROL  CRT,! {5 
CONTROL  CRT, 0; 59 
OUTPUT  CRTj"DATE:" 

CONTROL  CRT,!  |6 
CONTROL  CRT.0J59 
OUTPUT  CRT r TIME:" 

CONTROL  CRT  ,! »6 

OUTPUT  CRT  USING  Headlnage 

CONTROL  CRT,! »8 

! 

Box_9nd:  t 
FOR  I*!  TO  4 

IF  BIT<Key_id,5)  THEN 

OUTPUT  CRT  USIN8  Keyinage: I ,MS<Menu_num  ,I ) 

ELSE 

OUTPUT  CRT  USING  Skeyinage? I ,MS< Menu_nun ,I ) 

END  IF 
NEXT  I 
OUTPUT  CRT 
FOR  1*5  TO  8 

OUTPUT  CRT  USING  Keyinage 1 1  ,M$< Menu_nun  ,  I  ) 

NEXT  I 


title  IS  to  begin' 


Attenuation  menu 


*  wt 


773B  ! 

7738  SUB  Serial no 

7740  r+#****#***#**##***##»**#***#»*#«*»##»***#»*#**#«*»***#»»»#***«*»***#»**** 

7742  I  See  Hachine  Serial  Numbers  ,  < 

7744  !-#****« *******##*#4»* •*****•## *#*»•*»»*»»#♦***##»»*#»»»*#*»*#«»*»***»»#** 

7748  COM  i^Sysdaia/  SeMal_nuM$  .Lasers!  •)  ,Fi  lter_f  lag  ,Fi  lter<  *)  ,Num_focus  ,Focu 
s( *  >  .Cutoff  ,Low_«ave ,High_uave .Det_switch 
7748  I 

7750  OUTPUT  KBO  USING 

7752  PRINT  TABXY<B,10)j "  Machine  Serial  Number:  “8iSerial_nutn$ 

7754  I 

775B  ON  KEY  5  LABEL  "PROCEED"  GOTO  Done 
7758  WaiteriGOTO  Waiter 
7760  Done: SUBEND 
77R2  » 

77R4  ! 

7768  r.-r  ‘^NGetint<Prompt*  .Lo.Hi  ) 

7768  1 +♦*»*♦»*****»**»»»»•»#**»**** »•»*#•*»•****»*****»•»**#******»»****»*#•+ 

7770  !  FNGetint:  for  inputting  integer  values 
7772 

7774  INTEGER  Ualue.I 

7776  DIM  Inp*[80] 

7771  ! 

7780  •  Prompts  the  user  for  an  integer  with  the  prompt  Prompts. 

7782  I  Data  entry  is  forced  to  a  positive  integer  within  the  range  of 

7784  t  Lo  &  Hi .  inclusively. 

7788  I 

7788  Get_it:PRINT  PromptSi 
7790  LINPUT  Inp$ 

7792  Inp$=TRIM$( Inp$) 

7794  PRINT  Inp$ 

7796  IF  LEN(Inp$>>5  OR  LEN<Inp$)*0  THEN  GOTO  Bad_inp 

7798  IF  LEN(Inp$)==5  AND  Inp$>”327B7"  THEN  GOTO  Bad.inp 
7800  1*1 

7802  WHILE  (I<»LEN(Inp$)) 

7804  IF  lnp*tljn<"0"  OR  Inp$[I»n>"9"  THEN  GOTO  Bad„inp 

7808  1*1+1 

7808  END  WHILE 

7810  Ualue=UAL< Inp$) 

7812  IF  Ualue<Lo  OR  Ualue>Hi  THEN  GOTO  8ad_inp 

7814  RETURN  Ualue 

7818  Bad_inp:  PRINT 

7818  PRINT  "You  must  enter  an  integer  value  between  ";Loi 
7820  PRINT  "and  "iHH".  inclusive." 

7822  PRINT 

7324  GOTO  Get_lt 

7826  FNEND 
7828  ! 

7830  I 

7832  DEF  FNGratinglWavelen ) 

7834  I +*♦**#»»*#**♦**»#*♦»••***♦»*#*'►•«•**#*»♦*♦♦•#*♦''*»•♦*#»**»•»*•*  •*•»»♦  + 

793S  !  FNGrat ingfUavelen ) :  This  determines  which  grating  is  required  for 

7838  1  a  wavelength  specified  in  the  calling  routine. 

7840  I -#**»**•*#»••####»**»•*****»# t*«*»*»«** »«#»*****•*»♦#•**»**»# »♦**♦♦♦*- 
7842  COM  /Addition/  Curr_wave .Gratings! *) ,Cur_grat ing ,Wave_step 

7844  INTEGER  I 

7846  I 

7848  FOR  IsGrating3!0>  TO  1  STEP  -1 

7850  IF  Gratings! I  )<=Wavelen  THEN  RETURN  !I) 

7852  NEXT  I 

7854  RETURN  !-t)f  Unknown  grating  setting 

7856  FNEND 


*  It  n 


7866  I  REQUEST  ALIGNMENT  ROUTINE 

7868  I -***•*•**#****♦**#**»******»»##•###•*»»#**###*♦#♦»* •##»#*♦*♦•*»»•♦*»«*- 
7870  !  This  routine  gives  the  user  the  option  of  bypassing  the  alignment. 

7872  DISP  "Do  the  fiber  ends  need  to  be  aligned?" 

7874  BEEP 

7876  ON  KEY  1  LABEL  "YES"  GOTO  Align 

7878  ON  KEY  B  LABEL  "NO"  SOTO  Done 

7880  InfiniteiSOTO  Infinite 
7882  Align!  ! 

7884  OFF  KEY 

7886  OUTPUT  KBO  USING  "#,K"-"K" 

7888  DISP 
7890  CALL  Fibertype 

7892  CALL  Inallgn 

7894  CALL  Outellgn 

7896  Done:  I 
7898  OFF  KEY 

79&0  DISP 

7902  OUTPUT  KBO  USING  "#.K“i“K" 

7904  SUBEND 
7906  I 
7908  ! 

7910  SUB  Init_foa_cntrl 

7912  !  ••««•«•*»•»»««««•<•«•»•«»•*«*»«*«*•*«»»«»»««*«»«•»*««««<•**«  »«?»  + 

7914  I  FOA-2W00  new  commends  for  IR  detectors  and  mult 1-grat Ing  monochromator 
7916  !-•**•*»*•»*♦*♦*♦#*»***»••»**«**»•#•»*•##»♦***»»»♦»«»*»*»»»♦»»»*»»*»♦**»#- 

7918  COM  /lopaths/  @Foa2000 ,@Egg5205 ,@Tek7854  ,@Bncdelay ,Printer_add 
7920  COM  /Addition/  Curr_wave ,Grat ingsl  • > ,Cur_,grat ing ,Wave_step 

7322  I 

7924  CALL  F2000send(  " INZ  SEL  -4000  -RANGE  i  4000  +RAN6E  i  )MTAB",1> 

7926  ! 

7928  !  NOTE:  the  routines  below  are  written  in  FORTH,  the  native  operating 

7930  !  system  for  the  Z-80  processor  card  inside  the  FOA-2000  control  bo.-,  .• 

7932  I  For  more  information,  see  a  text  on  the  FORTH  language. 

7934  I 

7536  '•  Change  the  monochromator’s  motor  table  to  reflect  the  different  mono. 

7938  I  '  M+  i  changes  the  motor  step  routine’s  address  to  run  the  mono  in 

7940  I  the  other  direction. 

7942  !  1  MPY  •  is  the  multiplicative  display  scaling  factor. 

7944  I  12  DID  •  is  the  display  scaling  divisor,  DIU  will  change  with  the 

7946  !  selected  gratings  (see  the  GHAT?  commands  below).  This  one  is 

7948  I  the  value  for  grating  41. 

7950  I  -32000  FTARG  <  is  the  distance  to  loot  bad  wards  (in  motor  step?) 

7952  I  for  the  optical  sensor  edge  when  trying  to  locate  the  monochrom’s 

7954  •  zero  order  window. 

7956  !  >MTAB  copies  the  data  into  the  permanent  motor* table 

7958  I  -32700  -RANGE  l  allows  the  moves  in  complete  range  forward  and  bod 

7960  ! 

7962  CALL  F2000send(  "WAU  SEL  ’  M+  DIR  '  1  MPY  i  12  OIU  !  FTARG  '  MTAB 

",t  ) 

7964  CALL  F2000send( "WAV  SEL  -32700  -RANGE  I  32700  +RANGE  '  I  SENS  '  MTAB".! 
) 

7966  I 

7968  I  0  sex  I  allows  us  to  define  the  new  commands  below 

7970  CAuL  F2000send< "0  sex  i",!) 

7972  I 

7974  f  Since  the  computer  does  not  yet  know  what  grating  the  monochromator 

7976  '  is  turned  to,  set  current  wavelength  to  -1  (uninown) 

7978  I 

7980  Cur_gratlng=0 

7982  Curr_wave®-1 

7984  I 


t  W  ^  «  i  ^  ^ 


8rat ings< 2  J 800  !  grating  2  for  >*1800  nn  but  ^'2700  nn 
SnatingsO  >*2700  I  grating  3  for  >*2700  nn 
I 

I  Sat  default  wavelength  step  for  spectral  atten.  •&  diff.  nodal  alien. 


8004  Wave_st6p*10 

8008  ! 

8008  I  The  new  oo.nnand  MARKSTART  is  a  dunny  to  narl-  where  the  riow  connands 

8010  !  start  in  RAM.  If  this  routine  has  already  been  called,  then  we 

8012  '  will  recover  the  RAM  already  used  by  FORGET! Ing  the  defined  ocnnands 

8014  !  and  re-defining  then.  If  this  routine  hasn't  been  called  yet,  then 

8016  I  FORGET  MARKSTART  will  produce,  an  error.  This  is  OK,  but  we  can't 

8018  •  use  the  F2000send  routine,  since  it  will  trap  the  irror. 

8020  I 

8022  OUTPUT  fFoa2000 TFORGET  MARKSTART" 

8024  Wait:  Statby t=SP0LL{ @Foa2000 )  ITHIS  WILL  THROW  AWAY  TH’  ERROR  ON  POWER-U 
P 

8028  IF  BITiStatbyt ,4)  THEN  Wait 

8028  CALL  F20008end<  :  MARKSTART  t".l> 

8030  ! 

8032  1  This  is  the  zero  order  find  routine  for  the  nonochronator 

8034  ! 

8038  CALL  F2000send(":  FIN039  LOC  @  80  OUER  +-  -  GOTO  0  LOG  '  FTAPG  @  DARK  IF 

MER7  THEN  LOC  @  " , 1 ) 

8038  CALL  F2000send<  "120  ODER  +-  -  LIGHT  IF  MER7  THEN  ;F0UND  RESEL  i",;n 

8040  CALL  F2O00send(";  FIND88  0  LOC  !  40  LIGHT  IF  -40  LIGHT  IF  MER7  THEN  THEN 

0  LOC  !  FTARG  @  ^ , 1) 

8042  CALL  F2000send( "DARK  IF  0  LOC  1  FTARG  @  DARK  IF  MER7  THEN  THEN  FDLY  @  MI 
NDLY  !  FIND89  ;",n 

8044  CALL  F2000send(":  0SEEK  WAU  5EL  FIND88  0  FOUND  '  ; "  ,  U 

8048  I 

8048  I  These  are  the  connands  to  set  the  controller  to  understand  the,  grating 

8050  !  it's  trying  to  run.  GRATl  is  the  connand  for  grating  #1,,  etc. 

8052  I 

8054  CALL  F20005endr‘:  6RAT!  WAU  SEL  12  DIU  '  .'MTAB  i".1) 

8056  CALL  F2000send(";  GRAT2  WAU  SEL  8  DIU  '  >MTAB 

8058  CALL  F20005end<":  6RAT3  WAU  SEL  3  DIU  '  ;MTA.,  ".1) 

8060  ! 

8082  !  The  connand  CUTLOC  converts  notor  s'  .ps  into  wavelength.  THIS  SHOULD 

8084  !  NOT  BE  USED  OUER  GRIB"  Mill 


8068  I 

8068  CALL  F2000send<";  CUTLOC  DIU  @  DUP  0*  IF  DROP  ELSE.  /  THEN  MPY  @  DUP  0=  I 
F  DROP  ELSE  •  THEN  » "  ,  1  ) 

8070  1 

8072  !  The  connand  CUTWAUE  converts  wavelength  to  notor  steps.  THIS  SHOULD 

8074  I  NOT  BE  USED  OUER  GPIBfiMiN 

3076  ! 

3078  CALL  F2000send< " :  CUTWAUE  MPY  @  DUP  0*  IF  DROP  ELSE  /  THEN  DIU  !?  DUP  0* 
IF  DROP  ELSE  «  THEN  i"  ,1  ) 

8080  ! 

8082  I  The  connand  6ETNEARWAU  noves  the  nono  near  the  wavelength  desired. 

8084  I  If  the  wavelength  is  too  far  away,  it  will  need  to  be  called 

9086  I  nore  than  once.  If  an  error  occurs,  GEDTNEARWAU  returns  either  1 

8088  •  or  -1.  If  it  needs  to  be  called  again,  it  returns  0.  If  it  doesn't 

3090  I  need  to  be  called  again,  it  will  return  -88., 

8092  I  THIS  COMMAND  SHOULDN’T  BE  USED  OUER  GPIBil’ni! 


8094  1 

8096  CALL  F20@0send< " :  GETNEARWAU  LOC  @  CUTLOC  -  DUP  ABS  850  >  IF  LOC  ©  CUTLO 
C  SWAP  0<  IF  650  -  ELSE  "  ,  1  ) 

8098  CALL  F2000send( "850  +  THEN  CUTWAUE,  DUP  DUP  32000  ^  IF  DROP  DROP  1  ELSE  - 
2000  IF  DROP  I  ELSE  "  ,1  ) 

3100  CALL  F2000send(  "MOU  IF  MER7  1  ELSE.  0  THEN  THEM  T'  ’ :  F  fiPOP  -33  THEN  : 


1 


utuvtsxtsnytti  ca.uuui  u x  i ty  ^ u  w t »u  uui  i  i  ^  «t  1 1  wi‘u‘t.  •  •  j . 


CALL  F2000send<  " :  WAUE  WAU  SEL  20  0  DO  DUP  GETNEAR.WAU  DUP  -88  =  "  , )  ) 
CALL  F2000setld< "IF  DROP  0  LEAVE  ELSE  IF  1  LEAVE  THEN  THEN  LOOP  " , ! ) 
CALL  F20008«nd< "IF  DROP  ELSL  CVTWAVE  MOV  IF  MER7  THEN  THEN  i",l) 

! 

!  These  two  GPIB  cowpiands  ,  GERMAIN  and  INSB ,  select  one  of  the  two 
!  detectors  on  the  bench 
! 

CALL  F20006end(":  GERMAIN  HIGH  j“,l) 

CALL  F20005end( " :  INSB  SILICON  APOET  r.l) 


8142 

8144 

8146 

8148 

8150 

8152 

8154 

8156 

8158 

8160 

8162 

8164 

8166 

8168 

8170 

8172 

8174 

8176 

3178 

8180 

8182 

8184 

8186 

8183 

3190 

3192 

8194 

8196 

8198 

8200 

8202 

8204 

8206 

8208 

8210 

8212 

8214 

8216 

8218 

8220 

8222 

8224 

8226 

8228 


CALL  F2000send(":  DELAY  0  DO  255  0  DO  LOOP  LOOP  ; ".1 ) 

ICALL  F2000send< " t  GRELS  BSl  SEL  1000  MINDLY  !  LOG  @  3  AND  ",1> 

ICALL  F2000sendr’  DUP  LOC  !  SWAP  -  GOTO  >LEDS  ?",!) 

CALL  F20006end<";  OREL  8S1  SEL  MINDLY  !  LOC  @  3  AND  ".U 
CALL  F20006end( "  DUP  LOC  f  SWAP  -  GOTO  >LEDS  ; "  ,  1  > 

CALL  F20008end<":  TURN  70  1000  6REL  432  50  GREL  32  DELAY  -40  1000  GREL  ; 

CALL  F2000send<";  1T01  WAV  SEL  24  OIV  !  >MTAB  t",n 
I 

I  Disable  definition  of  new  forth  words 
! 

CALL  F2000send( "1  SCX  !"  .1  ) 

DISP 

SUBEND 


SUB  Ff normal i ze( Data_f lag* ) 

I +**»»*♦**»»»»*#»»*»*♦»«»»»#»»*»»»»»*»»*»» »♦»»*♦*»♦»**•»*♦«***♦»»***♦**♦+ 

!  NORMALIZE  FAR  FIELD  DATA;  Normalise  the  farfield  pattern  with  respect 
I  to  the  maximum  detected  signal. 

COM  /Farfield/  FfieldvaH *)  ,Num_point5 , Farfield! *)  ,Ffield_id$ 

COM  /Fftempdata/  Ffrawdata! •  )  ,Ffdi f fdata(  -  )  ,Ff smoothdata! * ) 

I 

INTEGER  I ,J 
REAL  Maxval 
I 

Maxval-'=-327G7 

CALL  Rundisplay! "Normalising  fa; — field  pattern.") 

! 

!  Determine  which  data  set  to  normalise,  then  do  it. 

I 

IF  Data_flag!6=="RAU  DATA"  THEN 
FOR  1=1  TO  Num_polnts 

IF  Farfield! I  ,1  )>Haxval  THEN  Naxval=Farf ieid! I  ,  1  ) 

NEXT  I 

FOR  1=1  TO  Num_points 

Farfield! I  ,1  )=Farf ield! I , 1 ) /Maxval 
NEXT  I 
END  IF 

! 

IF  Data_flag$="DIFF"  THEN 
FOR  1=1  TO  Ffdiffdata!0,0) 

IF  Ffdiffdata!  1 ,1  )>Maxval  THEN  Mi;xval=Ff  di  f  f data!  I  ,  I  ) 

NEXT  I 

FOR  1=1  TO  Ffdlffdata!0,0> 

Ffdiffdata! 1,1  )=Ffdif fdata! 1 ,1 )/Maxval 
NEXT  I 
END  IF 


IF  Data  f I agS-^" SMOOTH"  THEN 


I  \  X  I  »  w 


8238  Ffsmoothtiala(  I  ,1  >=Ffstnoothdata<  I  ,  1  )/Maxval  • 

8240  NEXT  I 

8242  END  IF 
8244  SUBEND 
824B  f 
8248  ! 

8250  SUB  Ffdiff 

8252  !+»♦»**»***»»****•»*••*♦»•**•»'»»»•»»»#»**►* »#♦»***»»#»»*»*»»»«*»»** »»*»*+ 

8254  !  Ffdiff:  Differentiates  integrated  farfield  pattern  that  is 

8258  I  derived  by  the  knife-edge  technique  (see  note  below). 

8258  !-**•***«***•*****••*•***•***»»*«*****♦*♦*****•»**♦♦*****»*•**»»«*»»♦*»»- 

8280  !  This  routine  is  used  to  differentiate  the  farfield  pattern  with  respect 

8262  !  to  3in<theta).  Note  that  differentiation  should  actually  be  with 

8264  !  respect  to  the  vertical  scanner  position,  but  the  above  method  is 

8286  •  equivalent  (and  simpler)  because  there  is  a  linear  relationship  between 

8288  !  the  scanner  position  and  6ln( theta),  and  we  are  not  interested  in  the 

8270  I  magnitude  after  differentiation  since  we  will  normalise  anyway. 

8272  •  Also  note  that  this  routine  takes  the  negative  derivative  due  to  the 

8274  I  physical  motion  of  the  farfield  scanner  (see  the  RAW  data  plot). 

8276  ! 

8278  COM  /Fftempdata/  Ffrawdata( *  )  .Ffdif fdata( *  )  ,Ffsmoothdata( »  ) 

8280  ! 

8282  INTEGER  I 


CALL  Rundisplay( "Differentiating  fai — field  pattern.") 

FOR  1=2  TO  Ffrawdata(0,0) 

Ffdiffdata(I-t  ,0 )=Ffraudata( 1,0) 

Ffdiffdata( I-t  ,1  )=-( Ffrawdata( I , 1 )-Ffrawdato( I-l  ,1  ) )/( Ffrawdata(  I  ,0)- 


Ffrawdata( I-l  ,0 ) ) 


NEXT  I 

Ffdiffdata(0,0)*Ffrawdata(0,0)  1 


iReduce  the  number  of  points  by  1 


SUBEND 


8306  SUB  Ffcorrect 

8308  I +*»»»***#♦#»»***»•*»••»•»•*****»•*••**»****»**»»*»*«»••*•♦»**»•*  »•♦*•»♦+ 
8310  I  FFCORRECT:  This  corrects  far-field  measurements  for  COS(PHI) 

8312  I -#»»*»**#***♦**»**•»#»**•#***»*♦»••»*•**•»##»»***»*»*•*»»»»»♦»♦*•♦**♦*♦*- 

8314  I 

8316  COM  /Fftempdata/  Ffrawdata( *  )  ,Ffdif fdata( •  )  .Ffsmoothdatal •  ) 

8318  ! 

8320  INTEGER  I 

8322  REAL  Slntheta 

8324  I 

8326'  CALL  Rundisplay( "Correct ing  far-field  pattern.") 

8328  ! 

8330  FOR  1=1  TO  Ffdif fdata(0  ,0  ) 

8332  Sintheta=Ffdiffdata(I ,0) 

8334  Ffdlffdata( I  ,1  )=Ffdif fdata( 1 ,1 )*5QR( 1 -Sintheta*Sintheta  ) 

8336  NEXT  I 

8338  ! 

8340  SUBEND 


8346  DEF  FNGetffwave 

8350  I  FNGetwave:  this  function  asks  the  operator  for  the  wavelength  for 
8352  I  the  farfield  scan. 

3356  COM  /Sysdata/  Serlal_num$t 401 , Lasers! •) ,Fi lter_f lag  ,Fi 1 tersl *) ,Mum„focus 
, Focus! *  )  .Cutoff ,Low^u3ve  ,High_uaye  ,Det_5witch 

nrvTMT  TAnvv/i  i n  .  •*  »* 


83B4  ! 

83BB  I 

83B8  SUB  Allgn<fl>?i3$, Step_len,Fail_flag,Min_factor. Accuracy  ) 

8370  !+•*******#*•»»** »4*»»*#***«*****»***»**»*«*«*#»*»«f»«»»*»»*, 

8372  I  FIBER  ALIGNMENT  MODULE  3/8/90 

8374  !-***♦***.«•******»»********••»*♦*•***»•***♦»»»«»*»»»**♦«»*(►♦»»♦»♦*,»»*«♦»_ 

837G  I  This  Module  is  called  by  both  Inalign  and  Outalign.  It  is  responsible 
8378  !  for  the  alignpient  of  a  single  axis  only  (specified  in  the  call). 

8380  ! 

838.2  COM  /Align_read/  Reading 
8384  REAL  Signal  I 

838B  INTEGER  Position  .Step 

8388  I 

8390  Step=ABS< Step_len )  IStore  the  absolute  value  of  step 

8392  Maxal lowed- . 3  1300  nU  naxlnuM  allowable  signal 

8394  Att-0  iStarting  attenuator  setting 

839B  PRINTER  IS  CRT  IPrint  out  table  headings 

8398  PRINT  "  " 

8400  PRINT  "  " 

8402  PRINT  "  " 

8404  PRINT  USING  "7X  ,7A  .6A  .3X  .  1 4A  .4D" i"AXIS  .Axis*  ."Step  length  =" .Step_len 
8406  PRINT  “ 

8408  PRINT  USING  "4X  .  1 0A  .9X .BA .8X  .8A" » "status"  ." s ignal"  .  “posit  ion" 

8410  PRINT  "  - " 

8412  I  Define  axis  and  initialise:  r 

8414  CALL  F2000send<  Axis*!  1  .P0S(  Axis*."-"  )-l  ]8.Axi5*tP0S<  Axis*  )+1  ;  1  IS."  COU 
PL" ) 

8416  I 

8418  Start:  Position=0  'Cone  back  here  only  if  signal  greater  than  flo/.al  lowed . 
8420  Reading=FNUoltmeter( Accuracy )  'Get  a  readina  from  the  5205/7 

3422  PRINT  USING  "4X . 1 0A .8X .M .DDDDDO .8X .DDDD .D" i " INITIAL"  .Reading .Pos i t ion 
8424  IF  Reading>Maxal lowed  THEN  IMake  sure  5205/7  isn’t  saturated 

842G  GOSUB  Set_attn 

8428  GOTO  Start 

8430  END  IF 

8432  I 

8434  Signal 1=Reading  'Store  initial  signal  before  Moving 

843B  Posit ionl=Posit ion  'and  initial  position  in  case  it’s  nax 

8438  Pos i t ion-Pos i t ion+S lep_len  'Increnent  position  by  step  length 

8440  IF  Posit lon<“800  OR  Po5ltion)800  THEN  GOTO  Failure.  'Keep  in  range 

8442  CALL  F2000send( UAL*( Posi t ion >S "  "SAxis*,!  )  'Move  to  the  new  position 
8444  PRINT  "  Checking  direction" 

844G  Reading=FNUoltmeter<  Accuracy )  'Get  another  recsdino  fron  the  5205/7 

8448  PRINT  USING  "4X  .  1  1 A  .7X  .M. DDDDDD  ,8X  .DDDD  .  D" ;  "FIRST  STEP"'.Rrading  ,Fos  i  t  ion 

8450  IF  Reading>Maxa 1  lowed  THEN  'Again  check  for  saturation 

8452  GOSUB  Set_attn 

3454  GOTO  Start 

84SG  END  IF 

8458  ! 

84S0  !  If  the  signal  is  getting  stronger,  keep  going  in  this  direction. 

84G2  '  If  not,  reverse  directions  and  start  on  the  other  side  of  the  tst 
8464  !  point. 

846B  ! 


8468 

IF  Reading'iSlgnal  1  THEN 

8470 

PRINT  "  Reversing  direction" 

8472 

Step_len®-Step_len 

'Step  in  the  other  direction 

8474 

Positlon=Posl t lon+5tep_len 

'Move  back  to  original  position 

84,76 

CALL  F2000send(UAL*<Po6ition)8." 

"8,Axis*,1  ) 

8478 

ELSE 

8480 

PRINT  "  Direction  okay" 

8482 

Signal  I'Reading 

IStore  a  new  Ma,<  value 

3484 

Posit  ion  1 =Pos it  ion 

land  corresponding  position 

o  '  oq 

Chjn  TfT 

I  *- 


Ki 


.  i‘ 


8494 

8496 

8498 

8500 

8502 

8504 

8506 

8508 

8510 

8512 

8514 

8516 

8518 

8520 

8522 

8524 

8526 

8528 

8550 

8532 

8534 

8536 

8538 

8540 

8542 

8544 

8546 

8548 

8550 

8552 

8554 

8556 

8558 

8560 

8562 

8564 

8566 

8568 

8570 

8572 

for 

8574 

8576 

8578 

8580 

8582 

8584 

8586 

8588 

8590 

rxr-nn 

8594 

8596 

0598 

8600 

8602 

8604 

8606 

8608 

8610 

8612 

8614 


CALL  F2000send<UAL$<Posltion)&"  "a.Axis$,1) 

Now  §tart  looking  for  thd  signal  to  begin  decreasi-ng  again, 
indicating  that  ue  have  passed  the  MaxiMum  level.' 


•Get  a  reading  from  the  5205 
•Check  again  for  saturation 


Reading=FNVol tneter<  Accuracy ) 

IF  Reading)Maxalloued  THEN 
GOSUB  Set.attn 
GOTO  Start 
END  IF 

PRINT  USING  "4X.10A,8X,M.DDDDDD,8X,DDDD.D"s''riAX  SEARCH"  .Reading  ,Pos  i  t  ion 

! 

IF  Reading>Signal 1  THEN  iSignal  still  increasing 

PRINT  "  Signal  still  incheasing” 

Signal Is'Reading  lAnd  put  the  new  level  in  register 

Positibn1=Position  lAs  well  as  its  position 

GOTO  Loopl 
END  IF 

If  signal  is  decreasing,  keep  noving  past  the  peak  until  signal  is 
some  percentage  of  the  max  value  to  avoid  peaking  on  a  noise  spile: 

IF  Reading>Min_f actor*Signal 1  THEN  GOTO  Loopl 

CALL  F20005end<  UAL$(  Pos  1 1  ionl  )8."  "8.Axl5$,1)  iMove  to  max  position 
Reading=FNVol tmeter( Accuracy  )  iRe-confirm  max  signal 

PRINT  USING  "4X ,I0A ,8X .M.DDDDDD ,8X .DDDD.D" ; "FINAL”  .Reading .Posit ionl 
I 

CALL  Setscale< Accuracy .Reading  ) 

BEEP 

CALL  Cleardisplay 

SUBEXIT  ^ 

I 

Set_attn:Att-Att+l 
IF  Att>4  THEN 
BEEP 

OUTPUT  KBD  USING  “#,K‘’i"K" 

GCLEAR 

CONTROL  CRT.l j  10 

OUTPUT  CRT? "ALIGNMENT  DIFFICULTIES” 

OUTPUT  CRT?  "Signal  greater  than  "8.UAL$(Maxalloued  >8."  volts;  too  great 
proper  alignment.” 

Hang_over:  GOTO  Hang_over 
ELSE 

CALL  F2O00send<UAL$( INT(Att ))&”  ATIENUAT",!) 

END  IF 
GOTO  Start 
! 

Failure:  Fail_flag=l 
SUBEXIT 
SUBEND 


SUB  Cleardisplay 

OUTPUT  KBD  USING  "f,K"?"K" 
GCLEAR 
SUBEND 

I 

! 

SUB  SteptestiAxis*) 


IChange  attenc'itor  to  reduce  signal 
IHave  we  run  out  of  range? 

•If  so  then  error 


I  STEPTEST 


!  !  -  -  1  ’ 


i/8/90 


1  «  t  y.  ,  .  I  1  ^  i  . 


i  t.. 


OOUL.  {  pdf  Clints  ttlu  iUWUI  pUD4.VJL^it  iiliAC,  1  ^  i  ,  i  X.  J  'MU  i  ./ 

8624  !  All  parameters  should  be  specified  in  motor  steps,,  which  arc  twice  as 

8626  !  lahge  as  displayed  on  the  front  panel  for  the  x  and  y  axes,  and  are  in 
8628  f  the  ratio  of  10:8  larger  for  the  z  axis.  Front  panel  reads  in  microns. 
8630  !-**♦*♦* ********»*****»**#*#**»*4**#*»4«******«*»»* *«♦**»«»**♦♦♦♦♦»**♦»»»- 

8632  ! 

8634  CALL  F2000send(UAL$<0)&“  ATTENUAT",!) 

8636  CALL  F2000send("XMIT  CHOP-ON  SPOT-IN") 

8638  CALL  F20006end( "GERMAIN  UOUT  FF-OUT  TARGET-OUT") 

8640  Step^'BG 

8642  PRINTER  IS  PRT 

8644  PRINT  "  " 

8646  PRINT  "  AXIS  ,Axls$ 

8648  CALL  F2000send<  Ax is*C  1  .P0S(  Axis$  , "-"  )- 1  ]&Axis$CP0S(  Ax i 5$  , 1  i  I  IS. "  C 

OUPL" ) 

8650  PRINT  "  " 

8652  PRINT  USING  " 10A ,2X , 10A" s "POSITION" , "SIGNAL" 

8654  Position«-700 

8656  CALL  F2000send(UAL$(Posltion)S"  "&Axis$,l) 

8658  I  Hang_it:  GOTO  Hang_it 

8660  ! 


8662  Loopsy:  IF  Posit ion<=600  THEN 
8664  Reading=FNUoltmeter( . 1  ) 

8666  PRINT  USING  "DDOD.D ,5X .M.DDDDDDD" iPosit ion  , Reading 

8668  PoSition=Position+Step 

8670  CALL  F20006end(UAL$<Position)&"  "8.Axis$,1) 

8672  GOTO  LoopSy 

8674  END  IF 

8676  Positiona0 

8678  CALL  F2000send<UAL$<Position)&"  "8,Axis$,l) 

8680  PRINTER  IS  CRT 

8682  SUBEND 
8684  ! 

8686  ! 

8688  SUB  Inalign 

8690  l+****»*«**4****»4»*»4»*»»»***»*»«4**»»»»***«»»****»*»*»»>*»«0»»*»44»«»»*+ 

8692  I  INPUT  AUTO-ALIGNMENT  MODULE  3/8.r90 

8694  !-**»*»*»»*»»»***»»»»»*»*»*»**»*«»»»»***»*»»»*»»**»»**»»*»«»»»»»*»4»4»44*- 

8696  I 

8698  COM  /A1 ign_param/  Ap(*)  I Auto-al Ignment  parameters  set  by  FIBERTYPE 
8700  COM  /Align_read/  Reading 

8702  I 

8704  REAL  Sig_change 

8706  INTEGER  Trial_no 

8708  DIM  5ig< 10) 

8710  I 

0712  CALL  Rundi5play< " Input  Auto-Al ignment  in  progress.") 

0714  I 

8716  I  Test  to  see  if  the  fiber  type  has  been  set. 

8718  ! 

8720  IF  Ap<0)=0  THEN  CALL  Fibertype 

S72Z  i 


8724  !  Initialise  parameters; 

8726  Rough_dx=Ap( 1 ) 

8728  Rough_dy=Ap< 2 ) 

8730  Rough_d2=Ap ( 3  ) 

8732  Fine_dX*Ap<4) 

8734  Fine_dy»Ap<5 ) 

8736  Fine_dz=Ap<6) 

8738  Rough_min®,95 

8740  Fine_min=.98 

8742  Rough_acc=.2 

8744  Fine_acc=.1 

o-  m  T-  •  - ! 


•Step  size  fnr  rniinh  alignment 


IStep  size  for  fine  alignment 


ISearch  past  the  peat  for  this  pcrccrtl  of  m.s.-;  power 
ISame  for  fine  (change  in  conjunction  w.  accuriscv  ) 

! Accuracy  used  in  calling  EG&G  in  rough  align 
(Accuracy  for  fine  (change  w/Fine„min) 


3754 
sumed. " 

IF 

Rough_dx=20 

THEN 

PRINT 

TABXY(5,G)i 

"F iber 

diameter 

of 

50 

microns 

1 5  as 

3756 

IF 

Rdugh_d>t-3G 

THEN 

PRINT 

TA8XY<5,6)5 

"F iber 

diameter 

of 

85 

microns 

IS  as 

sumed. " 
8758 

IF 

Rough_dx=40 

THEN 

PRINT 

TABXY(S,6); 

"Fiber 

1 

diameter 

of 

100 

micr  ons 

is  a 

s sumed. 

3760 

IF 

Rough_dx*60 

THEN 

PRINT 

TABXY(5,6)s 

"Fiber 

diameter 

of 

150 

microns 

IS  a 

SSUMSd. " 

87S2  WAIT  2 

8764  CALL  Rundigplay< "  "  )  ‘ 

8766  ! 

8768  i  Begin  the  alignwant  loop.  Come  back  in  the  event  of  failure  in  c. 

8770  Retry:  IFirst  initialize  loop  parameters  and  set  up  system 

8772  OFF  KEY 

8774  Trial_no=Trial_no+1 

8776  Fail_flag=0 

8778  PRINT  TABXY< 60 . 1 0  ) ; 

8780  PRINT  USING  '*  I0A  ,00"  i  "Inalign  t  "  ,Trial_no 

8782  CALL  F2000send( "XMIT  LED  LED-ON  CHOP-ON  SPOT-IN") 

8784  CALL  F2000send< “GERMAIN  UOUT  FF-OUT  TARGET-OUT") 

8786  CALL  F20003end< "STAGE0"  .1  ) 

8788  I 

3790  !  Rough  align  each  axis.  After  each  alignment  call,  check  the 

8792  !  alignment  parameter.  If  it  falls,  do  the  alignment  manually. 

8794  ! 

8796  CALL  Align( " IN-X“  ,Rough_dx ,Fai l_f lag ,Rough_min ,Rough_acc ) 

8798  IF  Fall_flag=l  THEN  Failure 

8800  CALL  Allgni  " IN-Y" ,Rough_dy ,Fail_f lag ,Rough_min ,Rouqh_acc ) 

8802  IF  Fail_flag=l  THEN  Failure 

8804  CALL  Align( “ IN-Z"  ,Rough_dz ,Fai l_f lag ,Rough_min ,Rough_acc ) 

8806  IF  Fall_flag=l  THEN  Failure_z 

3808  CALL  F2000send< "STAGE0"  ,1  ) 

8810  I 

8812  !  Now,  fine  align  each  axis.  Again,  test  alignment  parameters  and 

8814  !  do  the  alignment  manually  if  any  parameters  are  not  met. 

8816  ! 

8818  CALL  A1 lgn(  " IN-X " ,Fine_dx ,Fail_f lag ,Fine_min  ,Fine_acc  ) 

8820  IF  Fail_flag=1  THEN  Failure 

8822  CALL  A1 ign( " IN-Y" ,Fine_dy ,Fai l_f lag ,Fl ne_min ,Fine_acc  ) 

8824  IF  Fall_flag=1  THEN  Failure 

8826  CALL  A1 ign( " IN-Z " ,Fine_dr ,Fai l_f lag ,Fine_mi n  ,Fine_acc  ) 

8828  IF  Fail_flag=1  THEN  Fallure_z 

8830  CALL  F2000send< "STAGE0" ,1 ) 

8832  ! 

8834  I  Test  to  see  how  repeatable  the  alignment  is.  If  there  is  more  than  11', 
8836  !  difference  in  signal  between  alignments,  give  user  the  choice  to  retry. 
8838  I 

8840’  Sig< Trial_no )=Reading 

8842  IF  Trial_no<2  THEN  !Do  alignment  at  least  twice,  test  for  stability 
8844  GOTO  Retry 

8846  ELSE 

8848  Sig_change=1 00»<  Sig<  Trial_no  )-Sig( Tr ial_no-1  )  )/Sig<  Tr ial_no" 1  > 

8850  IF  Sig„change>1  THEN 

8852  PRINT  USING  "22A ,MDD.D ,22A ,DD ,4A  ,DD" i "A  change  in  signal  of  "  ,Sig_ 

change,"  occured  between  INALIGN  trial " ,Trial_no  , "  and" ,Trlal._no-1 

8854  PRINT  "Press  f1  to  RERUN  the  alignment  routine,  f5  to  EXIT," 

8856  ON  KEY  1  LABEL  "  RERUN"  GOTO  Retry 

8858  ON  KEY  5  LABEL  "  EXIT"  GOTO  Cleanout 

8860  Snooze_dude:  GOTO  Snooze_dude 

8862  END  IF 

8864  END  IF 

8866  ! 


U'O  1  -t  'U  X  UuJ  »UU  X  • 


\Jt  I 


I 


887G  BEEP 

8878  BEEP 

8880  WAIT  2 

8882  CALL  Cleardisplay  < 

8884  SUBEXIT 

8888  ! 

8888  I  If  any  of  the  success  parameters  are  not  met,  this  manual  alignment 
8890  I  routine  Is  entered  to  give  the  user  manual  control  of  the  FOA-2000 
8892  !  and  prompt  him  to  manually  align  the  fiber.  Failure_2  anticipates 

8894  !  particular  errors  which  result  from  non-optimal  placement  of  the  fiber 

889G  !  in  the  vacuum  chuck.  The  user  is  prompted  to  focus  the  fiber  end  at  a 

8898  I  position  particular  to  this  system  figured  to  encounter  the  least  error. 

8900  ! 

8902  Failure_2:BEEP 

8904  IF  Trial_no>l  THEN  GOTO  Failure 

890B  CALL  F2000send(  "ALIGN  INZ  COUPL  3000  DARK'',1  )  iFlnd  edge  of  INZ  sensor 

8908  CALL  F2000send< "INZ  ZER  -900  GOTO  INZ  ZEP".l)  iBack  up  and  stop 

8910  CALL  F2000send< "250  IN-Z",1) 

8912  CALL  Cleardisplay 

8914  PRINT  TABXY( 1 ,t7),"INALIGN  —  Unsuccessful  auto-alignment." 

8918  PRINT  TABXYt 1  , 1 8  ),  "Adjust  the  input  end  of  the  fiber  in  the  vacuum  chuck 

unt i 1 " 

8918  PRINT  TABXYt 1  , 1 9  ) , " it  comes  into  rough  focus  on  the  monitor.  Then  press 
RE-TRY." 

8920  ON  KEY  5  LABEL  "PROCEED"  GOTO  Quit 

8922  ON  KEY  G  LABEL  "  RE-TRY  AUTO"  GOTO  Retry_prep 

8924  Uait_here:  GOTO  Wait_here 

8928  I 

8928  Failure:  OFF  KEY 
8930  CALL  Cleardisplay 

8932  PRINT  TABXY(  1  , 1 7 > , " INALIGN  —  Auto-alignment  unsuccessful  in  the  IN-Z  mo 
tor . " 

8934  PRINT  TABXY( 1  , 1 8  ) ,  "A1 ign  input  end  of  fiber  using  the  FOA-2000  panel  con 
trols." 

3938  ON  KEY  5  LABEL  "PROCEED"  GOTO  Quit 

8938  ON  KEY  8  LABEL  "  RE-TRY  AUTO"  GOTO  Retry_prep 

8940  Wait„there!  GOTO  Wait_ther€ 

8942  l" 

8944  Retry_prep:  • 

8948  OFF  KEY 

8948  CALL  Cleardisplay 

3950  CALL  Rundisplay( "Input  Auto-Alignment  in  progress."! 

8952  GOTO  Retry 

8954  ! 

8956  Quit!  I 
8958  OFF  KEY 

8980  OUTPUT  KBD  USING  "#,K"!"K“ 

8962  GCLEAR 

8964  SUBENO 
8986  I 
8988  ! 

8970  SUB  Outalign 

8972  !+*»*»«**#»»»*«#»*•»»»»»*#*#**»»»»»**♦•*•»*»(>»**»♦*»►»»»♦»*»»♦»*»*'"'*»»»»  + 

8974  I  OUTPUT  AUTO-ALIGNMENT  MODULE  3/8/90 

8978  !-*»**##»»*»##**•##•#*»*»*»*»•»»••»*«*•***»*»**#«»♦*»»*»»»»*'»»♦*»»*♦»»*»♦- 

8878  I 

8980  COM  /Align_param/  Ap(*)  I  Auto-alignment  parameters  set  by  FIBERTYPE 
8982  COM  /Align_rBad/  Reading 

8984  I 

8988  REAL  Sig_change 

8988  INTEGER  Trlal_no 

8990  DIM  Sig<10) 


9000  I 

9002  IF  Ap<0>a0  THEN  CALL  Fibertypa 

9004  ! 

9006  !  Initialize  parameterd:  i 

9008  Rough_dx=Ap(  1  )  iStep  size  for'  rough  aligriMCnt 

90 1 0  Rough_dy-Ap  <  2 ) 

9012  Rough_dz«Ap<3 ) 

9014  Fine_dx*Ap( 4 )  iStep  size  for  fine  alignment 

9016  Fine_dy=Ap<5> 

9018  Fine_dz-Ap< 6 ) 

9020  Rough_Min=.95  ! Search  past  the  peak  for  this  percent  of  max  power 

9022  Fine_mln=.98  ISame  for  fine  (change  in  conjunction  w/accuracy ) 

9024  Rough_acc=.2  lAccuracy  used  in  calling  EG8.G  in  rough  align 

9026  Flne_aco=.l  lAccuracy  for  fine  (change  u/Flne_Min) 

9028  Trial_no=0 

9030  ! 

9032  I  Remind  the  user  what  your  fiber  type  is. 

9034  I 

9036  IF  Rough_dx-20  THEN  PRINT  TABXY( 5 ,6 > t “Fiber  diameter  of  50  microns  is  as 
sumed. " 

9038  IF  Rough_dx“36  THEN  PRINT  TABXY( 5 ,6 ) i "Fiber  diameter  of  85  microns  is  as 
sumed. " 

9040  IF  Rough_dx=40  THEN  PRINT  TABXY( 5 ,6 >! "Fiber  diameter  of  100  microns  is  a 
s sumed. " 

9042  IF  Rough_dx=G0  THEN  PRINT  TABXY( 5 ,6 ) ; "Fiber  diameter  of  150  microns  is  a 
ssumed. " 

9044  WAIT  2 

9046  CALL  RundisplayC  ") 

9048  ! 

9050  I  Begin  the  alignment  loop.  Come  back  in  the  event  of  failure  in  z. 

9052  Retry:  'First  initialize  loop  parameters  and  set  up  system 

2054  OFF  KEY 


9056  Trial_no='Trial_no+1 

9058  Fail„flag=0 

9060  PRINT  TABXY(G0,10)i 

3062  PRINT  USING  " 1 1 A  ,DD" ("Outal ign  #  " ,Trial_no 
9064  CALL  F20005end( "XMIT  LED  LEO-ON  CHOP-ON  SPOT-OUT") 

9066  CALL  F2000send( "GERMAIN  UOUT  FF-OUT  TARGET-IN") 

9068  CALL  F20005end(  "STAGE0" .1 ) 

9070  I 

9072  •  Rough  align  each  axis.  After  each  alignment  call,  check  the 

9074  I  alignment  parameter.  If  it  fails,  do  the  alignment  manually, 
9076  I 

9078  CALL  Align!  "0UT--X"  ,Rough_dx  ,Fai  l_f  lag  ,Rough_min  ,Rough_acc  ) 
9080  IF  Fail_flag=l  THEN  Failure 

9082  CALL  Align(  "OUT-Y" ,Rough_dy ,Fai i_f lag ,Rough_min  ;Rough_3cc ) 

9084  IF  Fall_flag=t  THEN  Failure  * 

9086  CALL  Align!  "OUT-Z" ,Rough_dz ,Fai l_f lag ,Rough_min ,Rough_acc ) 

9088  IF  Fail_flag=1  THEN  Failure_z 


9090  CALL  F2000send< "STAGE0"  ,1  ) 

9092  • 

9094  !  Now,  fine  align  each  axis.  Again,  test  alignment  parameters  and 

9096  !  do  the  alignment  manually  if  any  parameters  are  not  met. 

9098  I 

9100  CALL  Align! "OUT-X"  ,Fine_dx ,Fail_f lag ,Fine_min  ,Fine_acc  ) 

9102  IF  Fail_flag=l  THEN  Failure 

9104  CALL  Align!  "OUT-Y" ,Flne_dy .Fai l_f lag ,Fine_min  ,Fine_acc  ) 

9106  IF  Fail_flag*l  THEN  Failure 

9108  CALL  A1 ign( "OUT-Z"  ,F ina_dz ,Fai I_f lag ,F i nc_min ,F ine_acc I 
9110  If-  Fail_flag=l  THEN  Fail ure_z 

9112  CALL  F2000send< "STA8E0"  .1  ) 

9114  I 

I  r  .1  t  -  «  ^  1.  .  ,  .  ;  ^1,  1  -V  n.«  V  1  ,  t  ^  t  f  t  I  ^  ^ 


!Dii  alignment  at  least  twice,  test  for  stability 


;-nfirT,i 


oiys  1  riai„nu /"tieauiiiy 
91.24  iP-  TrlaUno<2  THEN 

‘91 2B  SOtd  Retry 

9} 28  ELSE 

9130  Si§_change*100*(Slg<Trial_^no>-Sig<Trial_no-1 )  )^Sig( Trial_no-l  ) 

9,1 3Z  IE  iig_btiange>l  THEN  i 

9134  PRINT  USINS  "ZZA .MDD.D ,22A .DD ,4A .00" ? "A  change  in  signal  of  "  ,Sig_ 

change,"  occured  between  QUTALISN  trial* ,Trial_no and" ,Trial_iio-l 

9138  PRINT  "Prase  fl  to  RERUN  the  alignment  routine,  fS  to  EXIT.” 

9138  ON  KEY  1  LABEL  "  RERUN"  GOTO  Retry 

9140  ON  KEY  5  LABEL  "  EXIT"  GOTO  Cleanout 

9142  Snoo2ei_nan!  GOTO  Snoo2e_nari 

9144  END  IF 

9148  END  IF 

9148  1 

9150  I  Now  clean  up  and  quit. 

9152  ! 

9154  PRINT  TABXYl 18 , 1 2  )  ."Output  fiber  end  successfully  aligned." 

9158  Cleanout!  OFF  KEY 

9158  BEEP 

9180  BEEP 

9182  WAIT  2 

9184  CALL  Cleardlsplay 

9188  SUBEXIT 

9168  ! 

9170  !  If  any  of  the  success  parameters  are  not  met,  this  manual  alignment 

9172  !  routine  is  entered  to  give  the  user  manual  control  of  the  FOA-2000 

9174  1  and  prompt  him  to  manually  align  the  fiber.  Failure_z  anticipates 

9178  !  particular  errors  which  result  from  non-optinal  placement  of  the  fiber 

9178  !  in  the  vacuum  chuck.  The  user  is  prompted  to  focus  the  fiber  end  at  a 

9180  !  position  particular  to  this  system  figured  to  encounter  the  least  error. 

9182  I 

9184  Failure„2!  BEEP 

9188  IF  Trial_no>l  THEN  GOTO  Failure 

9188  CALL  F20i0send( "ALIGN  OUTZ  COUPL  3000  DARK",1>  IFind  edge  of  OUTZ  sensor 
9190  CALL  F2000send< "OUTZ  ZER  -900  GOTO  OUTZ  ZER",I)  IBack  up  and  stop 

9192  CALL  F2000send( "250  0UT-Z",1) 

9194  CALL  Cleardlsplay 

9198  PRINT  TABXY< 1 , 1 7  )  ."OUTALIGN  —  Auto-alignment  unsuccessful  in  the  OUT-Z 
motor. " 

9198  PRINT  TABXY< 1  ,18)  ."Adjust  the  output  end  of  the  fiber  in  the  vacuum  chuc 
k  unt i 1 “ 

9200  PRINT  TABXY( 1  , 1 9  ) , " it  comes  into  rough  focus  on  the  monitor.  Then  press 
RE-TRY." 

9202  ON  KEY  5  LABEL  "PROCEED"  GOTO  Quit 

9204  ON  KEY  6  LABEL  "  RE-TRY  AUTO"  GOTO  Retry_prep 

9208  Walt._here:  GOTO  Wait.here 

9208  ! 

9210  Failure;  OFF  KEY 


CALL  Cleardlsplay 

PRINT  TABXY< 1  jl7 ) ."OUTALIGN  —  Unsuccessful  auto-al ignmsnt . " 

PRINT  TABXYI I ,18)  ."Align  output  end  of  fiber  using  the  FOA-2000  panel  co 

S. " 

ON  KEY  5  LABEL  "PROCEED"  ;2T0  Quit 
ON  KEY  8  LABEL  "RE-TRY  AUTO"  GOTO  Retry_prep 
Ualt_there:  GOTO  Wait_there 

t"" 

Retry_prep!  ! 

OFF  KEY 

CALL  Cleardi splay 

CALL  Rundlspiayf "Output  Auto-Alignment  in  progress.") 

GOTO'  Retry 

I 


WWL_w««  ll> 


9245  SUBEND 
9248  i 

9250  1  ; 

9252  SUB  Ne>^tuava<  Wave len)  i 

925B  !  SET  NEXT  WAUELENSTH  MODULE  VERSION  2. HR 

9258  !-***»******##»****#♦*#♦♦#•**#*••»*#»**•»»****#♦**»*#*»#»*»***,*#*#♦#*,*#_ 

9260  COM  /Sysdata/  Serlal_nui*i$  ,Laser8(  •  )  ,Fllter_f  lag  ,F1  Uers<  •  )  ,Nutn_focus  ,Foc 
usi *  >  .Cutoff  ,Low_uave,High_uave ,Det_swltch 

9262  COM  /Addition/  Curr_uave,Gratlngs<* ) ,Cur_grating,Wave  step 

9264  INTEGER  Index 

9266  DIM  Cnd$t  80 1  .DutnSC  40 1 

9268  Cnd**"" 

9270  I 

9272  1  First,  naka  sure  wavelength  called  is  not  out  of  range. 

9274  IF  Wavelen<Lou_wave  OR  Wavelen>HiQh  wave  THEN  GOTO  Filter_err 

9276  I 

9278  !  Next,  figure  out  which  grating  to  use. 

9280  Nea_grat ing=FNGrat ingC  Wave lari  > 

9282  t 

9234  !  If  we  don’t  know  what  wavelength  we  were  at,  which  grating  we  were 

9286  !  using,  or  the  grating  we  want  isn’t  the  grating  currently  in  use, 

9288  !  we  will  ask  the  user  to  switch  the  grating  by  hand. 

9290  ! 

9292  IF  Curr_uave»-I  THEN 

9294  DISP  "PLEASE  TURN  TO  GRATING  NUMBER" ;Neu_grat ing 

9296  Cur_grating*Neu_grating 

9298  BEEP 

9300  ON  KEY  5  LABEL  "PROCEED"  GOTO  Proceed 

9302  Infinite;  GOTO  Infinite 
9304  Proceed;  I 
9306  OFF  KEY 

9308  CALL  F2000send<"1TO1  300  WAVE", 1)  lElininate  possible  backlash 

9310  OUTPUT  KBD  USING  "#,K";"K“ 

9312  DISP  iClear  grating  request  off  screen 

9314  END  IF 

9316  ! 

9318  IF  Curr_uave=»-1  OR  Cur_grat ing<>New_grat ing  THEN 

9320  OUTPUT  0UM$  USING  .  GRAT"",D, . ,#" »NeU_grat ing 

9322  CMd®*Cmd$&Dum$ 

9324  WHILE  Cur_grat ing<>New_grating 

9326  CALL  F2000sendr' f T01  300  WAVE  TURN",1) 

9328  WAIT  1.5 

9330  Cur_grat ing®< Cur_grat ing  MOD  3>+1 

9332  END  WHILE 

9334  END  IF 

9336  ! 

9338  IF  Curr_uav€>Wavelen  THEN  1  eliminate  backlash 

9340  C«d$*Cmdi&VAL$(Wavelen-40)8."  WAVE  " 

9342  END  IF 

9344  ! 

9346  CmdS»Cndf&VAL*<Wavelen)&"  WAVE  " 

9348  Curr_wave«Wavelen 

9350  ! 

9352  !  In  the  original  FOA-2000,  the  monochromator  only  covers  the  range  from 

9354  i  800  to  1600  nM.  For  this  range,  only  two  cutoff  filters  were  needed, 
9356  I  one  to  cover  800  to  1000  hm,  and  another  to  cover  1000  to  1600  nm.  The 
9358  I  value  at  which  the  filter  was  switched  was  denoted  Irt  the  software  as  a 
9360  1  parameter  named  Cutoff.  The  NRL  system  requires  five  cutoff  filters,  so 

9382  1  we  need- an  array  to  pass  the  values  of  the  wavelengths  at  which  the 

9364  I  cutoff  filters  should  be  switched.  For  this  we  use  an  array  called 
9386  !  Fllteri*),  which  Is  passed  to  this  subroutine  by  the  Sysdata  CHM  bloci  . 


I  it,  i> 


9376 

9.378 

938® 

^9382 

9384 

9386 

5388 

9390 

9392 

9394 

9396 

9398 

9400 

9402 

9404 

9406 

9408 

94!0 

9412 

9414 

9416 


;  t  iitt:.!  k'lwUIixwVi  vl  twt  . 

!  tli€s  file  that  ue  are  using  a  nonoohroneter  with  cutoff  filters,  which 
.!  •  iS  hefeessary  in  order  to  set  the  Fllter_flag  to  2  <which  in  turn  flags 
f  the  prograw  to  determine  which  value  of  Filter? *>  to  use). 

!  ,> 

!  The  cut-on  wavelengths  for  the  cutoff  filters  are  as  follows! 

!  Filter? 1  )  ‘  500  nm 

1  Filter? 2)  »  900  nn 

I  FilteHB)  1525  nm 

I  Fllter?4)  *  2175  nm 

I  Filter?5)  ^  3150  nm 

! 

1  If  Filter_f lao*2 ,  we  are  using  the  monochromator  with  cutoff  filters 
!  installed  in  SEVERAL  positions  of  the  filter  wheel,  so  decide  which 
!  one  to  use.  If  Filteh_f laQ*0 ,  we  are  not  using  the  cutoff  filters. 

IF  Filten_flag»2  THEN 

FOR  Index- 11  TO  0  STEP  -1 

IF  Filters? Index XaWavelen  THEN  GOTO  Change 
NEXT  Index 
GOTO  Filter_err 
END  IF 


9418  Change!  Cmd*»Cmd*8.VAL$?  Index  >&"  FILTER  " 


9420 


9422  I 

9424  !  Figure  out  which  detector  to  use. 

9426  ! 

9428  IF  Wavelen<Oet_switch  THEN 

9430  CmdS®Cmd#8i "GERMAIN"  iLess  than  switch  so  use  Germainium 

9432  ELSE 

9434  Cmd*»Cmd*8t‘'INSB"  lOtherwise  use  Indium-Ant imonide 

9438  END  IF 

9438  CALL  F2000S6nd?Cmd$,l ) 

9440  Done!  SUBEXIT 


9442  ! 

9444  Filteh_err!  BEEP 

9448  DISP  "NEXTWAVE  —  Uavlength  “SVAL$?Wavelen  )&"  is  not  available  on  the 

filter  wheel . " 


9448  Deadl:  GOTO  Deadl 
9450  SUBEND 
9452  t 
9454  ! 

9456  SUB  Clearup 

9458  !+**♦**•**»*»*#♦»#»•*»*#♦*»*•***•*»»*#******»»*•♦»**•♦»♦»»***♦*»»»•♦♦♦»•+ 

9480  !  CLEARUP:  This  routine  can  be  called  to  clear  the  I/O  path  to  the  locL- 

9482  I  in  amp,  and  reset  the  phase  setting  to  maximize  sensitivity. 

9464  I -**•♦♦#♦#*»»»»**#«*»♦***»*»*##**♦»*#*•»#»*♦<►#•***»»♦»«•>»♦»**«♦#» *♦♦♦»«- 
9486  COM  /lopaths/  @Foa2000 ,@Egg5205 ,0TeK7854 ,@Bncdelay  ,Pr inter_add 
9488  CLEAR  7 

9470  CALL  Cleardisplay 

9472  PRINT  TABXY? 15 ,8)! "Please  be  patient,  this  might  take  a  moment." 

9474  CALL  PZaaSsend?  "LED  SPOT-OUT  TARGET-OUT  ILUJMIN  tinUT  GERMAIN") 

9476  CLEAR  @Egg5205 

9478  CALL  ES205comm? "A2  1" ) 

9480  CALL  Set  sea  la? .1  ,1  ) 

9482  BEEP 

9484  PRINT  TABXY? 22 ,14 )  j "EG&G  Lock-in  cleared  and  rescti" 

9486  CALL  F20008end? "ALIGN" ) 

9488  WAIT  3 

9490  CALL  Cleardisplay 

9492  SUBEND 

9494  I 

9498  I 


95J56  ,1.  This  module  contains  the  primary  code  to  run  a  DMA.  measurement.  It 

9508  I  diff.err  from  ^  ipictril  attenuation  measurement  in.  that  it  allows  a 
9510  1  number  bf  UaVelengih  scans  to  be  performed  on  a  long  length  of  fiber 
9912  1  before  eutbaek.  NA  Restrictors  are  requested  for  'each  run.  After 
9514  1  cutback.  Restrictors  are  requested  in  the  same  order  as  used  originally. 

9516  I  Data  is  stored  in  two  arrays,  Dmarundata ,  for  measurements  before,  and 
9518  !  Dmarefdata,  fbr  measurements  after  cutback. 

9520  1 

9522  COM  /lopaths/  @Foa2000  ,@Eoo520S ,@Tek7854  ,@Bncdelay.,Printer_add 

9524  COM  /Sysdata/  Serial_num$  ,La5er8( * > ,Filter_f lag ,Fi lter< *  )  ,Num_focus  ,Focu 

s<  * ) , Cutoff  ,Lou_(»iave  ,High_uave  ,Det_suitch 

9526  COM  /Wavelength/  Wajvelength<  •  )  .Numsteps 

9528  COM  /Fiber/  Fiber_id$ ,Fiber_len ,Log_t ime$ 

9530  COM  /Dmadata/  Dmarundata! ♦) ,Dmaref data! *)  ,Dmaattendata< ♦)  .Dma  id$ 

9532  ! 

9534  REAL  Measurement  ,A1 ignl  ,Align2 ,Al ign_change 

9536  INTEGER  Restr_no ,Run_no .Wavecount .Totalruns 

9538  DIM  RestrSdl  )t  17] 

9540  ! 

9544.  !  Set  up  parameters. 

9544  Dmarundata! 0 ,0  )=Numsteps 

9546  Dmarefdata! 0 ,0  )=Numstep8 

9548  Dmarundata! 1 ,0  )®Flber_len 

9550  Dmarefdata!  1  ,0  >=»Fibar_ien 

9552  Dma_ld$=Flbar_ld*&''  "8,Log_timB$ 

9554  Run_no*0 

9556  ! 

9558  I  Start  the  “run"  !i.e.  long)  fiber  measurements. 

9560  Next^hestr:  ! 

9562  Run_no*Run_no+1 

9564  Restring9*FN6etrestrictor$! “LONG”  )  'Ask  for  NA  Restrictor  # 

9566  Restr„no=UAL!Re5trlng$1 1 j 1 ] )  'Extract  the  number  from  the  string 

9568  Dmarundata! 0 ,Run_nO )=Restr_no  'Store  it  at  the  top  of  each  column 

9570  Dmarefdata! 0 ,Run_no  )=Restr_no  !And  in  this  array  as  well 

9572  Once_again:  OFF  KEY  !Sct  up  the  optics 

9574  ~  CALL  F2000send( "0  IN-X  0  IN-Y  0  IN-Z"  )  IMake  sure  it’s  at  0  location 

9576  CALL  F2000send! "0  OUT-X  0  OUT-Y  0  OUT-Z"  ) 

9578  CALL  F'^0008end(  "LED  LED-ON  CHOP-ON  SPOT-OUT  XMIT"  ) 

9580  CALL  F2300send! “TARGET-OUT  UOUT  GERMAIN") 

9582  Allgnl»FNUoltmeter< .05) 

9584  CALL  F2000send! "LAMP  LAMP-ON"  ) 

9586  ! 


I  Now  the  actual  measurement  loop. 

PRINT  TABXY! I  ,6  )  j "Long  fiber  wavelength  scan  in  progress  using  Restri 
#"!Restr_no  ,  , 

FOR  Wavecount:=l  TO  NumstepsX  (7"  U^CCoum-b 
CALL  Nextwave! Wavelength! Wavecounjf^)  > 

CALL  SetfocustWavelengthtWavecount  )  ) 

Measurernent^FNUoltmeter! .01  ) 

Dmarundata! Wavecount ,Run_no)=Mea5urement 
NEXT  Wavscount 


■CALL  F20008end!"0  IN-X  0  IN-Y  0  IN-Z" >  !Go  back  to  alignment  position 
CALL  F2000send!"0  OUT-X  0  OUT-Y  0  OUT-Z")  !In  case  of  manual  adjstmnt 
CALL  F20008end! "GERMAIN  LED  LED-ON”)  IPrep  for  LED  voltage  reading 
AlignZ^FNUoltmeter! .05) 

!  Check  signal  integrity. 

Aiign„changea100»! Align  1-Align2  ).,  .91  ignl 

IF  Ailgn_change>1  THEN  IMore  than  V/,  signal  change 

BEEP 

CALL  Cleahdi splay 
PRINT  TABXYd  ,10)5 

rnTMT  “-rA  n,  oa*^  . 


•  I  CTTT  X  \ 


ITotal  number  of  runs  <one  per  restrictor) 
iStore  total  number  of  runs  here 

PLEASE  CUT  BACK  THE  FIBER") 


{ 


lit  iHia  t  astr  iUvUi  ,  pr  eas  t  i  . 

9630  PRINT  TABXC/<  I  ,14))"To  PROCEED  with  the  test,  press  f5.  To  EXIT  th 

a  test ,  press  f8. “ 

9632  ON  .KEY  1  LABEL  "  RE-RUN"  GOTO  Once_again 

9634  ON  KEY  5  LABEL  "PROCEED"  GOTO  Choose_another 

9636  ON  KEY  8  LABEL  "  EXIT"  GOTO  Done 

9638  Snoozer!  GOTO  Snooser 
9640  ELSE  i 

9642  PRINT  TABXYC 1  ,8  )  j  "A1  igniient  okayt  test  proceeding." 

9644  END  IF 

9646  I 

9648  Choosa_anothar:  OFF  KEY 

9650  PRINT  TABXY< I  ,10  )j “To  run  another  wavelength  scan  with  another  NA  res 

trictor  ,  press  f I . " 

9652  PRINT  TABXY< I  ,12  )j “To  proceed  to  the  cutback,  press  f5." 

9654  ON  KEY  1  LABEL  "CHANGE  RESTRCTR"  GOTO  Next_restr 

9656  ON  KEY  5  LABEL  "  GO  TO  CUTBACK"  GOTO  Cutback 

9658  ON  KEY  8  LABEL  "  EXIT"  GOTO  Done 

9660  Catch_here;  GOTO  Catch_here 
9662  I 

9664  Cutback;  OFF  KEY 
9666  Totalruns=Run_no 

9668  Dma(-urtdata<2  ,0  )=Totalruns 

9670  Dmarefdata<2 ,0  )-Totalruns 

9672  CALL  Flbehloadt " 

9674  CALL  Outalign 

9676  ! 

9678  •  Now  take  measurements  on  the  "ref"  (i.e.  short , cutback  )  fiber. 

9680  FOR  Run_no*t  TO  Totalhuns 

9682  BEEP 

9684  PRINT  TABXY( t  ,  10  )  t "Please  insert  Restrictor  #" ,Dmaref data( 0 ,Run_no ) , " 

and  press  f5  when  ready." 

9686  ON  KEY  5  LABEL  "PROCEED"  GOTO  And.again 

9688  Hang_on_hehe:  SOTO  Hang_on_here 

9690  ! 

9692  And_again;  OFF  KEY  iSet  up  bench;  do  it  all  in  case  of  manual  adjstmnt 

9694  ”  CALL  FZ0005end< “0  IN-X  0  IN-Y  0  IN-Z"  )  iMake  sure  it’s  at  0  location 

9696  CALL  F2000send<"0  OUT-X  0  OUT-Y  0  OUT-Z"  ) 

9698  CALL  F2000send< "LED  LED-ON  CHOP-ON  SPOT-OUT  XMIT"  ) 

9700  CALL  F200C8end< "TARGET-OUT  UOUT  GERMAIN") 

9702  Allgnl=FNUoltmeter( .05 ) 

9704  CALL  F2000send("LAMP  LAMP-ON") 

3706  I 

9708  !  Now  the  actual^^easurement  loop. 

9710  PRINT  TAB/y< 1  ,20 )  j "Cutback  fiber  wavelength  scan  in  progress  using  Re 

stricter  #"  ,QaaIfl«gtiarfa<  0  ,Run_no  ) 

9712  FOR  Wavecount=»l  TO  Numstepys  ^  ✓ 

CALL  Nextwavet  WavelengthtWavecountO  ) 

CALL  Set  focus! Wavelengtht Wavecount  ) ) 

Measurement»FNUoltmeter< .01  ) 

Umaret data! Wavecouni ,Run_no )=neasut  emen 
NEXT  Wavecount 


9714 

9716 

9718 

9720 

9722 

9724 

9726 

9728 

9730 

9732 

9734 

5736 

9738 

5740 

9742 

9744 


CALL  F2000send<"0  IN-X  0  IN-Y  0  IN-Z")  iGo  back  to  alignment  position 
CALL  F2000send<"0  OUT-X  0  OUT-Y  0  OUT-Z") 

CALL  F2000send< "GERMAIN  LED  LED-ON")  iPrep  for  LED  voltage  reading 
Allgn2»FNUoltmeter< .05) 

Check  signal  integrity. 

Allgn_change“t00*< A1 Ignl -A1 ign2 )/Align1 

IF  Allgh._charige>t  THEN  IMore  than  1%  signal  change 

CALL  Cleardisplay 
PRINT  TABXYd  ,10); 

PRINT  USING  "36A,MDD.D,9A"("The  LEO  alignment  signal  changed  by"  ,A 


vJ  I  *+  O 

e  test ,  press 

9750 

9752 

9754 

9759  Sleeper! 


f8." 

ON  KEY 
ON  KEY 
ON  KEY 
GOTO 


GOTO  And_again 
GOTO  On_dasher 
GOTO  Done 


1  LABEL  “  RE-RUN' 

5  LABEL  “PROCEED' 

8  LABEL  "  EXIT'' 

Sleeper 

9758  ELSE 

9760  PRINT  TABXY( 1 ,l0)i "Alignment  okay?  test  proceeding." 

9782  END  IF 

9764  On.dasher:  OFF  KEY 

976B  NEXT  Run_no 

9798  ! 

9770  Done:  OFF  KEY 

9772  CALL  Cleardisplay 

LOCAL  0Foa2000 
SUBEND 

I 


9774 

9776 

9778 

9780 

9782 


SUB  DmacoMp 


9789 
9788 

9790 
9792 
9794 

9799 
9798 

9800 
9802 
9804 
9806 
9808 
9810 
9812 
90t4 
9816 
9818 
9820 
9822 
9824 
9826 
9828 
9830 
9832 
9834 
9838 
9838 
9840 
9842 
9844 
9846 
9848 
9850 
9852 
9854 
9856 
9858 
9860 
9862 
9864 
9866 
9868 
9870 


!  DIFFERENTIAL  MODAL  ATTENUATION  COMPUTE  MODULE 
|-»*»******»»*#*#**»«»*#»#**#****»»***»*»***»*»*«*»*»*»*»»*»***»»»»**»»»- 

!  This  module  computes  the  fiber  spectral  attenuation  for  the  different 
I  NA  ranges  used  for  the  test. 

! 

COM  /Wavelength/  Wavelength!  *  )>,Numsteps 

COM  /Dmadata/  Dmarundata!  * ) ,Dmarefdata<  * ) ,Dmaattendata( *  )  ,Dtna_idS 

1 

INTEGER  I , J ,Run_no .Totalruns 
REAL  Steps_runs 
I 

Numstep3=Dmarundata<  0 ,0 ) 

Fiber_len=Dmarundata( 1 ,0 ) 

Totalruns*Dmarundata( 2  ,0 ) 

Since  only  the  (0,0)  slot  is  open  in  the  Dmaattendata  array,  parse 
the  number  of  wavelength  steps  (up  to  350)  and  the  number  of  DMA  runs 


uitn  different  Restrictors  (up  to 
parts  of  a  single  variable  called 
Steps^runs=Numsteps+Totalrun5/100 
Dmaattendata! 0  ,0  )=Steps_runs 


1 1  )  into  the 
“Steps_rUn5" . 


integer  and  fractional 


(I-/. 


FOR  I«t  TO  NumstepsK  /' 

Dmaattendata! 1 ,0  )=Wavelength!  I ) 

FOR  J*1  TO  Totalruns 

Dmaattendata! 0 , J )=Dmarundata!  0 , J ) 

Dmaattendata! I  ,J )=10»LGT!Dmaref data! I  ,J  >/Dmarundata! I  ,J  ) ) 
Dmaattendata! I  ,J  )=Dmaattendata! I ,J  )/Flt  5r_len 
NEXT  J 
NEXT  I 

SUBEND 


DEF  FNGetrestrictorS!Plot*) 

CHOOSE  NA  RESTRICTOR  MODULE 

-»#*»»*»»»*#»*##***#»•*#*###*##**#**#(«*»****#*»*#»«**•♦•»»»»♦*»»»»♦»**•- 

This  module  is  called  before  a  DMA  measurement  to  ask  the  user  which 
NA  Restrictor  he  desires  to  use  for  the  test.  It  also  pauses  to  allow 
the  Restrictor  to  be  put  in  the  holder  next  to  the  cut-off  filter  wheel 
After  the  test,  or  when  reviewing  recalled  data,  the  module  is  called 
again  to  determine  which  column  of  data  (one  corrospondi ng  to  roch 

:  v  \  -  i  I  .  ..  i  ^  ,,  .,1. 


9880  INTEGER  Index!  .IndexJ  ,Restr_no,Totalruns 
9882  DIM  ReStr$( n  }t17] 

9884  I 

9888  CALL  CleardlspUy 

9888  ! 

9890  !  See  if  this  is  the  first  run,  if  so  goto  ask  for  a  new  Restrictor. 

9892  Totalruns*FRACT<  Dinaattendata<  0 ,0 )  )*  1 00 

9894  IF  Totalruns*©  THEN  GOTO  New_restr 

9898  Reprint:  ! 

9898  PRINT  TABXY( 1  ,4 )  j "NA  Restrictor  values  in  the  present  data  set  are:" 
9900  FOR  Inde^:!"!  TO  TotairunS 

9902  PRINT  TABXY( 47+Indaxi*3 ,4 > tOMaattendata( 0 .Indexi ) 


'  $ 

9904 

NEXT  Indexi 

j  t  ll 

9908 

! 

;  1 

9908 

!  Ask  operator 

which 

restrictor 

9910 

Neui_regtr;  1 

J  S 

9912 

OFF  KEY 

9914 

Restr$(0)="0 

Full 

NA  =  .24" 

1  t' 

9918 

Restr$(  1  )=>"! 

NA  =  .04" 

<  1  p 

9918 

Re6trS(2)="2 

NA  =  .08" 

!  1  Ij 

9920 

Rastr$(3)="3 

NA  =  .10" 

J  1 

9922 

R6St‘rS<4)“"4 

NA  =  .13" 

;  1 

9924 

RestrS<5)*"S 

NA  =  .15" 

‘  '  i  ' 

9928 

Re6trS(G)="G 

NA  =  .18“ 

9928 

R€Str$<7)="7 

NA  =  .20" 

1- 

9930 

Re6tr$<8)*"8 

.04<NA<.08“ 

Ir 

9932 

Re6tr$(9>*"9 

.08<NA<.13" 

i 

9934 

Re6tr$< 10)=" 

10 

.I1<NA<.17 

1 

1 

9938 

R€str$( 1 1 )=" 

1 

.14<NA<.21 

i 

t- 

9938 

PRINT  TABXY(19,S); 

"  Restr.t 

T 

9940 

FOR  lndexj=0 

TO  n 

NA  Range 


PRINT  TABXY(25.IndexJ+7)tRestr$( Indexj  > 

NEXT  Indexj 
PRINT  "  " 

BEEP 

Restr_no=FN6et int< "Enter  the  restrictor  4  to  use:  ",0,!1) 

CALL  Cleardisplay 

The  next  condition  being  net  neans  we’re  preparing  to  plot  data; 
in  that  case,  go  down  and  return  to  Dnaplotprep.  Else  load  Restrictor. 
FOR  Indexi=l  TO  LEN(Plot$) 

IF  Plot*="PL0T"  THEN  GOTO  Headout 
NEXT  Indexi 


9988  Got_no:  ! 

9970  IF  Restr_no=0  THEN 

9972  PRINT  TABXYt 1  , 1 8  ) ; “No  NA  Restrictor  was  specified." 

9974  PRINT  TABXYt 1  , 1  8  ); "A  straight  Spectral  Attenuation  measurcnont  will  b 

e  performed," 

9978  ELSE 

9978  PRINT  TABXY< 1  ,15)  i 

9980  PRINT  USING  "30A  ,00 ,25A'' ;  "Please  insert  NA  Restrictor  4"  ,Restr_no  , "  a 

nd  press  f5  when  ready." 

9982  END  IF 

9984  ON  KEY  t  LABEL  "CHANGE  RESTRCTR"  GOTO  Kleenscreen 


9986  ON  KEY  5  LABEL  "PROCEED"  GOTO  Headout 
9988  Prang:  GOTO  Prang 
9990  I 

9992  Kleenscreen:  ! 

9994  OFF  KEY 

9998  OUTPUT  KBD  .USING  "#,K"i"K" 

9998  GOTO  Reprint 


RESTRCTR"  GOTO  Kleenscreen 
GOTO  Headout  IHead  back  to  Dnarun 


i.Clear  alpha’s  only 


fi 


a 

I 


f 

I- 


t 


i 


j 

-| 


^  I 

V  I 
-  e 


"m 


I 


i  . .  _  .  ,  , 

10008  ! 

10010  FNEND 
10012  ! 

100U  ! 

100 IB  DEF  FNDalaSource 

10018  !+*»»*»************************♦*****•**♦*•»»**»•»**•»•»*»»**»*»*»*♦♦»•»+ 
10020  !  DETERMINE  DATA  SOURCE  MODULE 

10022  I -»*******♦*»*»**»****»»***•♦****•*»***♦*##•»*#»*»»»#♦*»•♦**»***». »*»•»»- 
10024  I  This  routine  Is  called  before  each  fiber  test  is  performed,  to  determine 
10028  I  where  the  data  for  the  output  plot  is  to  come  from.  It  allows  a  user  to 
10028  !  review  data  from  a  previous  day  (computer  turned  off  in  between),  data 
10030  !  presently  in  the  memory  (earlier  the  same  day),  or  run  a  new  test. 

10032  I 

10034  PRINT  TABXY(4.15)j"To  access  data  from  an  archived  file,  press  RETRIEUE. 

II 

10038  PRINT  TABXY( 4 , 1 8  )  1 "To  review  data  presently  in  memory,  press  EXISTING  OA 
TA." 

10038  PRINT  TA8XY( 4 , 1 7  )  I "To  begin  a  new  Far  Field  measurement,  press  NEW  TEST. 


10040 

10042 

10044 

10048 

10048 

10050 

10052 

10054 

10058 

10058 

10060 

10062 

10084 

10068 

10088 

10070 

10072 

10074 

10076 

10078 

10080 

10082 

10084 

100P5 

10068 

10090 

imzz 

10094 
10398 
(0098 
(0100 
10102 
10104 
10106 
10108 
101 10 
10112 
10114 
10118 
10118 
10120 
10^22 
10124 


ON  KEY  1  LABEL  "RETRIEUE"  GOTO  Pull  it 
ON  KEY  3  LABEL  "EXISTING  DATA"  GOTO  Existing 
ON  KEY  5  LABEL  "  NEW  TEST"  GOTO  New_test 

Freeze:  GOTO  Freeze 

I 

Pulllt:  OFF  KEY 
CALL  Retrieve 

Source_f lag=2  .  !  Flag  number  to  retrieve  data  from  disl: 

GOTO  Scram 
Existing:  OFF  KEY 

Source_f lag=1  !  Flag  number  for  data  existing  in  memory 

GOTO  Scram 
New_test:  OFF  KEY 

Source_f lag-0  •  Flag  number  to  run  a  new  test 

Scram:  RETURN  Source_flag 
FNEND 


! 

SUB  Dmaplotprep 

I  PREPARE  DMA  DATA  FOR  PLOTTING 

! 

I 


COM  /Specattdata/  Specattdata( • > ,Specalt_id$ 

COM  /Dmadata/  Dmarundata( « ) ,Dmaref data( •  )  ,Dmaattendata( ♦  )  ,Dma_l d$ 

! 


! 


! 


INTEGER  ’ndixi ,Indexj .Indexk ,Numsteps ,Totalrun5  .Restr^n"  ,5tring._len 
DIM  ReStViccorSLdOl 


r’iumsitips— iili  \  uf’j^  ottBudataiOjO) ) 

To4a'.run5=FSBCTiOmaattendata(  0 ,0 )  )*  1 00 


(Integer  part  is  #  wave  steps 
IFract  part  is  It  NA  restr  runs 


Query:  I 

!  Print  Restrictor  values  in  the  data  set?  print  NA  ranges  for  each  value; 
I  query  the  user  as  to  which  set  to  plot;  extract  Restrictor  number  from 
I  string  (returned  from  FNGetrestrictor ) ;  search  data  for  desired  column. 


RestrictorS*FN6etrestrlctor*(  “PLOT" )  IQuery 
String_len“LEN( Restrictor* ) 

Restrictor*®" I  Restr#  "HRestrictor*! 1  ,2  !&" ;  "&Restriotor*[8 ,Str ing_len] 

! 

Restr_no®UAL(Restrlctor*[  12;21) 


■Extract  Restr_no  from  string 


IVilJil  if*  KGS  C  f  — UlHcia  I  1 1:«  lUtA  t  ti  \  ;  I  nuH  uu  i  u  i  Jui  lu^'^  u  i  Ji  ih 

10134  NEXT  Run_no 

10136  PRINT  TABXY( 1  , 1 2 > t "No  natch  for  this  Restrictor  t  .was  found  in  the  data. 

Pleasa  try  again.  (WAIT)" 

10138  WAIT  4 

10140  OUTPUT  KBD  USING  IClear  alpha’s  only 

10142  GOTO  Query 

10144  ! 

'0146  Found_coluinn:  ILoad  the  appropriate  DMA  data  in  the  Specattdata  array. 

10148  Speca t  t_i d*=Dma_i dS&Res  t  r 1 c  t ori 

10150  Specattdata<0,0>*Dnarundata(0 ,0)  ITransfer  number  of  points 

10152  Specattdata! 0 , 1  )“Dnarundata( 1  ,0 )  ITransfer  fiber  length 

10154  FOR  Index*!  TO  Nunsteps-1 

10156  Specattdata! Index ,0  )*Dnaattendata< Index  ,0 >  ILoad  wavelengths  first 

10158  Specattdata! Index ,1 )*Onaattendata! Index  ,Run_no  )  'Now  the  data 
10160  NEXT  Index 

10162  I  Spectral  attenuation  routines  now  nay  be  used  to  list  and  plot  data. 
10164  SUBENO 
10166  ! 

10168  ! 

10170  SUB  Ffsnooth!Data$  ) 

10172  !+**♦»**#***«#*»***»»**»»***»****•***•♦••»»»*****••»»***»»**»»•*•»(►»*»**+ 

10174  I  SMOOTH  FAR  FIELD  DATA 

10176  !-**♦***#»**•»#**##»**•»♦*♦****»*»**»**»*#**♦***»»*•»**##«***»*»•#*•*»•*- 

10178  1  This  routine  is  provided  to  offer  the  user  the  option  of  smoothing  the 
10180  1  far  field  data  by  a  variable  pointuise  number.  Smoothing  is  generally 
10182  !  desirable  owing  to  the  spike-generating  tendency  of  the  differentiation 
10184  !  process  used  to  derive  the  far  field  scan  values. 

10186  ! 

10188  COM  /Fftempdata/  Ffrawdata!  • ) .Ffdif fdata!  » ) .Ffsmoothdata!  * ) 

10190  ! 

10192  INTEGER  Smoothpts ,I ,J ,Num_point6 
10194  1 

10196  !  First  ask  for  the  number  of  points  to  use  in  the  smoothing  operation. 
10198  !  Set  an  upper  limit  of  a  25  point  smooth  (changable  if  necessary). 

10200  ! 

10202  CALL  Cleardisplay 
10204  PRINT  TABXY! 1  ,1 1  )i"  " 

10206  Smoothpt 6*FNGet int ( "Enter  the  number  of  points  to  use  in  the  smoothing  p 
rocedure : "  ,0  ,25  > 

10208  IF  Smoothpts=0  THEN  Smoothpts=l  'Smooth  by  0  pts  really  means  1 

10210  CALL  Cleardisplay 
10212  ! 

10214  !  Next  determine  which  data  set  to  smooth  (RAW  or  ROUGH),  and  smooth  it. 
10216  I 

10218  IF  Data$*"RAW  DATA"  THEN 

10220  Num_points=Ffrawdata(0  ,0  l-Smoothpts-f  I 

1 0222  Ff  smoothdata!'0  ,0  )*Num_points 

10224  FOR  1=1  TC  Num.points 

10226  Total=0 

10228  FOR  J-I  TO  Smocthpts-’-!-: 

10230  Total=Total+Ffrawdata! J  ,  1  ) 

10232  NEXT  J 

1 0234  Ff smoothdata!  1 ,0 )=Ffrawdata! I  ,0  ) 

10236  Ffsmoothdata! I ,1 )=Total/Smoothpts 

10238  NEXT  I 

10240  END  IF 
10242  ! 

10244  IF  Data$*"0IFF"  THEN 

1 0246  Num_point s=Ffdi f  fdata! 0 ,0  )-Smoothpt s+ 1 

10248  Ff6moothdata!0 ,0 )=Num_polnts 

10250  FOR  I»1  TO  Num_points“ 

10252  Tolal=0 


J  xJuU-o 

102SZ 

10264 

10266 

10268 

10270 

10272 

10274 

10276 

10278 

10280 

10232 

10284 

10286 

10288 

10290 

10292 

10294 

10296 

10298 

10300 

10302 

10304 

10306 

10308 

10310 

10312 

10314 
10316 

10315 
10320 
10322 
10324 
10326 
10328 
10330 
10332 
10334 
10336 
10338 
10340 
10342 
10344 
10346 
10348 
10350 
10352 
10354 
10356 

I  niTiCQ 

f  X/  W  w 

10360 

10362 

10364 

103GB 

10368 

10370 

10372 

10374 

10376 

10378 

10380 

10382 


Ffsmoothdata< I ,1  >=Total/Smoothpt 5 
NEXT  I 
END  IF 

!  . 

IF  D4ti*a''SM00TH"  THEN 

Num_poihts«Ff sMOothdataC  0 ,0 )-SMoothpt s+ 1 
Ff SMOothdata<  0  ,0  )=NuM_points 
FOR  I®1  TO  NuM_points 
Total=0 

FOR  J*I  TO  Smoothpts+I~l 

TQtal=Total+Ff SMOothdata<  J  ,  1  ) 

NEXT  J 

Ff sMoothdata( 1 , 1  )=Total/SMOothpts 
NEXT  I 
END  IF 

! 

IF  .rt00thpt6>l  THEN 

IF  Data*=^'' SMOOTH"  THEN 

PRINT  TABXYd  ,4)»"0ata  further  smoothed  " 

PRINT  USING  “7A ,00 , 1 SA“ I “using  a  "  .Smoothpts  , "  point  average." 
ELSE 

PRINT  TABXYM  ,4);"Data  smoothed  using" 

PRINT  USING  "2A  ,00 , 1 5A’' » "a  "  ,Smoothpts  , "  point  average." 

END  IF 
END  IF 

I 

SUBENO 

t 

i 

SUB  Cleardata 

!+♦*»»*♦*****#*»**♦**»***»*#»**§*»#**•»♦******«#»•* *»t*4**»* »♦»»»« »»»•»♦+ 

!  CLEAR  DATA  MODULE 

1 -*»*♦♦**»»»*♦#***»•**»*■•»***»*»#*♦•*»»•****»»»€§»»»»♦*»»»»*»»»»***♦»♦«♦- 

I  This  routine  can  be  called  to  effectively  clear  all  data  from  memory, 
i  It  simply  sets  all  parameters  equal  to  0. 

I 

COM  /Fiber/  Fiber_id$ ,Fiber_len,Log_ttme$ 

COM  /Specattdata/  Specattdatat ♦ ) ,Specatt_id$ 

COM  /Dmadata/  Dmarundatai  *  > ,Dmarefdata( *  )  ,Dmaattendata( » )  ,Dma„id!6 
COM  /Farfield/  Ff  leldvaK  *  )  ,Fnum_point5  ,Farf  leld(  ♦  )  ,Ff  leld._id$ 

COM  /Fftempdata/  Ffrawdatal  • ) ,Ffdif fdata( ♦ > ,Ff smoothdata(  » > 

COM  /Nearfield/  Nf leldvaK ♦) ,Num_points  ,Nearfleld( *)  ,Nfleld_id$ 

I 

INTEGER  I,J 

! 

IF  Specattdata! 0,0)00  THEN 
FOR  1=0  TO  Specattdata<0 ,0 ) 

FOR  J=0  TO  1 

Specattdata! I  ,J  )=0 
NEXT  J 
NEXT  I 

Specatt_id$="  " 

Clear$=" CLEAR" 

END  IF 

! 

IF  Omarundata! 0,0)00  THEN 
FOR  1=0  TO  Omarundata! 0,0) 

FOR  J*0  TO  Omarundata! 2  ,0 ) 

Omarundata! I  ,J  )=0 
Dmaref data! I ,  J  >=0 
Dmaattendata! I ,J  )=0 


UU  l\ 


10394  ! 

10395  IF  F^rfield(0.0)<>0  THEN 

10398  FOR  I»0  TO  Farf ield< 0 ,0 > 

10400  FOR  J«0  TO  1  . 

10402  Farfieldd  ,J)=0 

10404  Ffraudata( I  ,J  )«0 

10406  Ffdiffdatal I  ,J  )=0 

10408  Ffsmoothdatal I  .J >*0 

10410  NEXT  J 

10412  NEXT  I 

10414  Ffleld_id$="  " 

10416  Clear$sf"CLEAR" 

10418  END  IF 
10420  ! 

10422  CALL  CUardieplay 
10424  IF  Clear$*'‘CLEAR"  THEN 

10426  PRINT  TABXY(20,10)r'DATA  HAS  BEEN  CLEARED." 

10428  ELSE 

10430  PRINT  TABXY< 20,10 >» “NO  DATA  TO  CLEAR." 

10432  END  IF 
10434  WAIT  2 

10436  CALL  CleardiSplay 

10438  ! 

10440  SUBEND 
10442  ! 

10444  I 

10446  SUB  Proglist 

10448  !+**#*»«*»**********«***»****»#t*»»»*»»»*»*»*#»****»*#»**»*»******#*»*»*+ 

10450  !  PRINT  PROGRAM  LISTING  OR  PROGRAM  CONTENTS 

10452  I -#*»*»»♦**»*»*♦♦**»**♦♦****•****»*•#♦♦*♦*»**»**•***»*»•»**♦*»*»•* ***»»*- 

10454  I 

10456  CALL  CleardiSplay 

10458  PRINT  TABXY( 8 ,8 ) I "To  print  a  list  of  the  subroutines  contained  in  the  na 
star  " 

10460  PRINT  TABXY<  8  ,9  )  •;  "progran  ,  as  well  as  tiiuir  locations  within  the  program 
,  press  f  1  . " 

10462  PRINT  TABXY<8,1 1  );"To  print  the  entire  program,  press  f5." 

10464  PRINT  TABXY( 8 , 1 2 ) 5 "Be  foruarned  that  this  take  an  hour  or  more." 

10466  ON  KEY  1  LABEL  "CONTENTS"  GOTO  Contents 

10468  ON  KEY  8  LABEL  "PROGRAM  LISTING"  GOTO  List  it 

10470  Crash_out:  GOTO  Crash_out 
10472  ! 

10474  Listit:  OFF  KEY 

10476  PRINT  TABXY<20,1G); "PRINTING  PROGRAM  LISTING" 

10478  PRINTER  IS  PRT 

10480  LIST 

10482  PRINTER  IS  CRT 

10484  OUTPUT  KBD  USING  “#,K"t"K" 

10486  SUBEXIT 
10488  ! 

10490  Contents:  OFF  KEY 

10492  PRINT  TABXY<20,lG)r'PRINTING  PROGRAM  CONTENTS" 

10494  PRINTER  IS  PRT 
10496  ! 

10498  I  Now  the  contents.  Obviously,  when  the  software  is  changed, 

10500  !  the  list  of  subroutines  and  their  locations  must  be  changed. 


10502  ! 

10504  PRINT  "ROUTINE  NAME  LINE  NUMOER" 

10506  PRINT  " - " 

10508  PRINT  "Mainorog  10" 

10510  PRINT  "Sysinit  334” 

I■g■e1?  POTMT  7)9" 


I 

t  i  \  1 

Ml  W  I  I  A  «  w 

10522 

PRINT 

"Rethleve 

2308" 

10S24 

PRINT 

"Zcenter 

2548" 

10526 

PRINT 

"RUhdiiSplay 

2582" 

10528 

PRINT 

"Claardlspiay 

2608" 

10530 

PRINT 

"F2000sahd 

2630" 

10532 

PRINT 

"Preset 

2736" 

10534 

PRINT 

"EQQ5205coMrt 

2930" 

10536 

PRINT 

"FNI/cltMeter 

3016" 

10538 

PRINT 

"Setspele 

3314" 

10540 

PRINT 

"Arraybuild 

3362" 

10542 

PRINT 

"Flberident 

3646" 

10544 

PRINT 

"Fibertype 

3694" 

10546 

PRINT 

"Fiberload 

3830" 

10548 

PRINT 

"Specuaves 

3866" 

10550 

PRINT 

"Set  focus 

3954" 

10552 

PRINT 

"SpeoPUn 

4034" 

10554 

PRINT 

"Specref 

4082" 

10556 

PRINT 

“SpeCMeas 

4212" 

10558 

PRINT 

"Speecor 

4452" 

10560 

PRINT 

“Specatcomp 

4536" 

10562 

PRINT 

"Specatlist 

4626" 

10564 

PRINT 

"Speoatplot 

4752" 

10566 

PRINT 

"Nfieldvals 

5114" 

10568 

PRINT 

"Nf leldrun 

5196" 

10570 

PRINT 

"Nfieldplot 

5324" 

10572 

PRINT 

"Corediaw 

5534" 

10574 

PRINT 

"Ffieldvals 

5614" 

10576 

PRINT 

"FfleldrUn 

5708" 

10578 

PRINT 

"Ffield  plot 

5878" 

10580 

PRINT 

"Numapsr 

8434" 

10582 

PRINT 

"Menu 

6564" 

10584 

PRINT 

"Serialno 

7738" 

10586 

PRINT 

"FNGetint 

7766" 

10588 

PRINT 

"FNGratinQ 

7832" 

10590 

PRINT 

"Askal ign 

7862" 

10592 

PRINT 

" Inlt_foa_cntrl 

7910" 

10594 

PRINT 

"Ff norwal ize 

8160" 

10596 

PRINT 

"Ffdiff 

8250" 

10598 

PRINT 

"Ffcorrect 

8306" 

10600 

PRINT 

"FNGetuave 

8346" 

10602 

PRINT 

"Align 

8368" 

10604 

PRINT 

"StepteSt 

8608" 

10506 

PRINT 

" Inal Ign 

8688" 

10608 

PRINT 

"OUtal ign 

8970" 

10610 

PRINT 

"Ne>?tuave 

9252" 

10612 

PRINT 

"Cleanup 

9456" 

10614 

PRINT 

"Dmarun 

94  98" 

10616 

PRINT 

"DwacoMp 

9782" 

10618 

PRINT 

"FNGetres trie tor 

9854" 

10620 

PRINT 

"FNDatasoUrce 

10016" 

10622 

PRINT 

"Dmaplotprep 

1007b" 

10624 

PRINT 

"Ffsnooth 

10170" 

10626 

PRINT 

"Cleardata 

10320" 

10828 

PRINT 

"Progllst 

10446" 

10630 

PRINT 

"Flbertestl  (Specatten) 

10656" 

10632 

PRINT 

"Fibertest2  (DMA) 

10798" 

10634 

PRINT 

"Fibertest  3  (Far  Field) 

10946" 

10636 

PRINT 

"Fibectest  4  (pinhole) 

11006" 

10638 

PRINT 

"Fibertest  5  (near  field) 

11050" 

10640 

PRINT 

"Fibertest  6  (fiberload) 

1 1098" 

10642 

! 

10644 

PRINTER  IS  CRT 

.  •  4  t- 

f  T  j  f 

lUOOi.  i 

10654  I 

10656  SUB  FibertestK OPTIONAL  Sourc«_flag> 

10658  ! +♦****♦*#********«***•****♦*******«*♦♦»♦♦•♦*♦•***♦*»**•»»»«»♦*♦♦*♦»♦♦*«»+ 

10660  I  FIBERTEST  SUBPROGRAM  NO.  1  —  SPECTRAL  ATTENUATl'ON 

10662  I -**«*♦***••**«*****»****•♦***************•»*♦»«»*♦•***♦*♦♦»»♦♦*# »***4***- 

10668  DIM  Flaa8$tl03 

10670  IF  NPAR>0  THEN  ilf  source_flag  given  and  =  0 

10671  IF  SoUhce_flag=0  THEN  GOTO  Neu_testl 

10672  IF  Source_f lag*l  THEN  GOTO  Scale  IDala  already  loaded  in  memory 

10673  IF  SoUrce_f lag=2  THEN  GOTO  Plot_spec  IData  retrieved  from  disi' 

10674  END  IF 

10675  Neu.testI;  I 

10676  CALL  Fiberloadi"  Please  load  the  test  fiber.") 

10677  CALL  Fiberideht 

10678  CALL  Askalign 

10679  CALL  Lbgtihe 

1 0680  CALL  Specruni " OUERF ILL " > 

10681  CALL  F20006end< "GERMAIN"  ) 

10682  CALL  Fiberldadi "PLEASE  CUT  BACK  THE  FIBER") 

10683  CALL  OUtelign 

10684  CALL  Specrafi "OUERFILL"  ) 

10685  CALL  Spocatcomp 

10686  Scale:  ! 

10687  PRINT  TABXY(20. 16  )» "Select  the  desired  range  fo.r  the  plot." 

10688  BEEP 

10689  Flags**"" 

10690  ON  KEY  1  LABEL  "  dB/km"  GOTO  Kilo_db 

10691  ON  KEY  2  LABEL  "dB/100M"  GOTO  Hundred_db 

10692  ON  KEY  3  LABEL  "dB/10M"  GOTO  Tan_db 

10693  ON  KEY  4  LABEL  "  dB/h"  GOTO  Db_per_m 

10694  Out„to_lunch!  GOTO  Out_to_lunch 

10695  Kilo_db:l 

10696  Flags**"KILO" 

10697  GOTO  Got_f actor 

10698  Hundred_db:  ! 

10699  Flags**"HUNDRED" 

10700  GOTO  Got_f actor 

10701  Ten_db:  ! 

10702  Flags**"TEN" 

10703  GOTO  6ot_factor 

10704  Db,_per_M:  ! 

10705  Flags**"METER" 

10706  GOTO  Got_f actor 

10707  Plot_6pec:  ! 

10708  Flags**" 2" 

10709  CALL  Specatcomp 

10710  Got_factor:! 

10711  OFF  KEY 

10712  DISP 


107141 

10715  CALL  SpecatplotiFlags*) 


10716! 

10717!  Test  flag  values  returned  from  Specatplot 

10718  IF  Flag6**"RESCALE"  THEN  SOTO  Scale 

10719  IF  Flags**"LJ.STING"  THEN  GOTO  Print_list 


10720  IF  Flags** "STORE" 

10721  IF  Flags**“QUIT" 

10722  GOTO  Done 

10723  Print_list:! 

10724  OFF  KEY 

10725  DISP 


THEN  GOTO  Storeit 
THEN  GOTO  Done 


for  where  to  go  from  here: 

1  Rescale  plot  and  do  again 
!  Print  hard  copy  listing 
I  Archive  data 
I  None  of  the  above 


1  I  <-w 


W  V  wt  V.  A  V  •• 


10730  OFF  KEY 

10731  CALL  Archive 

10732  Do  net  I 

10733  OFF  KEY 

10734  DISP 

1073B  OUTPUT  KBD  USING 

10736  SUBEND 

10737  I 

10738  I 

10739  SUB  Fibertest2< OPTIONAL  Source_flag) 

10740  l+*itt*»*#f***»*#»»***»»#****#*»***#»#*»»«)-*»*#»«««*******»»»*#»«»*» 

10741  I  Fibertest2:  DIFFERENTIAL  MODAL  ATTENUATION 

10742  !-#*«******»»**•*******•»»•*♦*****»»#**«»*#*********##»*»♦#»*»»»»»» 

10743  !  This  module  controls  the  run  of  the  DMA  test. 

10744  ! 

10745  DIM  Flags$n0]  .RestrictorSt  171 

10746  ! 

10747  IF  NPAR>0  THEN  ilf  source_flag  given  and  0 

10748  IF  Source_flag»0  THEN  GOTO  New.test 

10749  IF- £curcei.flan»1  THEN  GOTO  Plot_prep  IData  already  loaded  in  memory 

10750  IF  Source_f lag=2  THEN  GOTO  Plot_prep  iData  retrieved  from  dish 

10751  END  IF 

10752  ! 

10753  Neu_test!  I 

10754  CALL  Fiberload(  "  Please  load  the  test  fiber." 1 

10755  CALL  Fiberident 

10756  CALL  Askalign 

10757  CALL  Logtime 

10758  CALL  Dmarun 

10759  CALL  Dmacomp 

10760  Plot_prep:  ! 

107B1  CALL  Dmaplotprep 

10762  ! 

10763  !  Prepare  scale  information  for  Specattplot: 

10764  ! 

10765  Scale:  I 

10766  PRINT  TABXY( 20 , 1 6  )  I "Select  the  desired  range  for  the  plot." 

10767  BEEP 

10768  Flags*="" 

10769  ON  KEY  1  LABEL  "  dB/km"  GOTO  Kilo_db 

10770  ON  KEY  2  LABEL  "dB/100m"  GOTO  Hundred_db 

10771  ON  KEY  3  LABEL  “dB/10m"  GOTO  Ten_db 

10772  ON  KEY  4  LABEL  "  dB/m"  GOTO  Db_per_m 

10773  Out_to_lunch!  GOTO  Out_to_lunch 

10774  Kilo_db;! 

10775  Flags$="KILO" 

10776  GOTO  Got_factor 

10777  Hundred_db:  ! 

10778  Flags$="HUNDREO“ 

10779  GOTO  Got_f actor 

10780  TeM_db:  ! 

10781  Flags$»"TEN" 

10782  GOTO  GOt_fector 

10783  Db_per_m:  I 

10784  Flag8$«"METER" 

10785  GOTO  6ot_factor 

10786  1 

10787  Got_factor;! 

10788  OFF  KEY 

10789  CALL  Cleardispiay 

10790  CALL  Specatplot(Flags$. 0,0, "DIFFERENTIAL  MODAL  ATTENUATION") 

10791  I 


*  t  IUi4  UU  (  U  V 


i.  w 


I  I  r  V. 


.'  »  «  W  A 


I  w  j  Jii  xr  ricJVs|oa»“*  ui\jj\u 

1079S  IF  Flaus$»"QUIT"  THEN  GOTO  Done 

10797  GOTO  Done 

10798  Print.lUt:! 

10799  OFF  KEY 


I  li 

None  of  the  above 


10800  OISP 

10801  OUTPUT  KBD  USING 

10802  CALL  Specatllstl  "PRINT  "SFiags* . "DIFFERENTIAL  MODAL  ATTENUATION 


Restrictor  #:  "8iUALS(  Restr_no  ) ) 

10803  GOTO  Done 

10804  Storeit!  I 

10805  OFF  KEY 
1080G  CALL  Archive 

10807  Done:! 

10808  OFF  KEY 

10809  CALL  Cleardi splay 

10810  SUBEND 

10811  I 

10812  ! 

10813  SUB  Fibertast3< OPTIONAL  Source_flag> 

10814  !+*♦**»♦♦♦♦*♦*••«***«*♦♦•*#***»**»♦•*•»**«»♦«»*»♦*•»♦*•*♦♦»♦»♦*♦*»»*♦»•»»+ 

10815  !  FIBERTEST  SUBPROGRAM  NO.  3  --  FAR  FIELD 

108 IS  !-«#♦»»**•*****♦♦•*♦**#*«***#••*♦»»«•***»*********♦**#♦♦*»*•••♦#♦♦**♦•***- 

10817  I 

10818  !  First  test  whether  or  not  to  run  a  new  test,  or  go  directly  to  plot. 

10819  ! 

10820  IF  NPAR>0  THEN  !If  source.flag  given  and  *  0 

10821  IF  Source_f lagOO  THEN  GOTO  Plotit  !i.e.,  data  in  Memory,  not  new  tfe 
st 

10822  END  IF 

10823  ! 

10824  CALL  Fiberload<"  Please  load  the  test  fiber.") 

10825  CALL  Fiberident 

10826  BEEP 

10827  Ftwave«FNGet f f wave 

10828  CALL  AsKalign 

10829  CALL  Ffieldvalsl "-.35  TO  .35  STEP  .0075") 

10830  CALL  Logtime 

10831  CALL  FfieldrUn(Ffuave) 

10832  CALL  Ffnormalize( “RAW  DATA") 

10833  Plotit:  ! 

10834  CALL  Ffieldplotl "RAW  DATA" ,"Far-Field  Raw  Data  (before  differentiation)" 

) 

10835  CALL  Ffdiff 

10836  CALL  Ff correct 

10837  Print_flag$="DIFF" 

10838  NohMalize.it: ! 

10839  CALL  FfnorMaliZel Print_f lag$  ) 

10840  CALL  Ffieldplot(Prlnt_flag* ,"  FAR  FIELD  PATTERN") 

10841  IF  Print_flag*»"SMOOTH"  THEN  GOTO  NorMali2e_it 

10842  SUBEND 

10843  I 

10844  I 

10845  SUB  Fibertest4( OPTIONAL  Source_flag) 

10846  !+#**»**•****»***##*#*#*•**•♦#*»**••**««*»**♦*♦*♦♦*•*♦*•*♦♦»»♦**♦*♦*»♦♦•♦+ 

10847  1  Fiberte8t4:  FARFIELD  WITH  PINHOLE  Ftb8rtest4  has  been  set  to  the 

10848  1  pinhole  farfield  test.  This  is 

10849  !  used  mainly  for  system  diagnostics. 

10850  I -**»«♦*****»*****#•*»****•*•**•**♦***♦***»»**»«•«•«••*»«****♦♦»•♦ ♦««*♦♦»- 

10851  CALL  Cleardlsplay _ 


10855  Ffpintest!  OFF  KEY 


Please  1  ad  the  test  fiber.") 


CALL  Fiberloadt" 

CALL  Fifaeriddnt 
CALL  Askalign 

CALL  Ffleldvalet "-.35  TO  .35  STEP  .0075") 

CALL  Ffieldrun(FN6etffwave, "PINHOLE"  ) 

CALL  Ffcorheot 

CALL  FfnornalizeC’RAU"  ) 

CALL  Ff ieldplot ( “RAW"  , “  Far  Field  Pattern  (usi  ng  pinhole  )"  ) 


1085B 

10857 

10858 

10859 

10860 
10861 
10862 

10863 

10864  SUBEND 

10865  I 

10866  ! 

10867  SUB  Flbertest5(0PTI0NAL  Sourfce_flas> 

1 0868  |+*****»«*****«**»*****«*******«»t#****«**»#***»*»**«*«t***«*«*****«**,*»+ 

10869  I  FI8ERTEST  SUBPROGRAM  NO.  S  --  NEAR  FIELD 

1 0870  1 -♦*****#•»»*********♦»«***#*•**#»»»#**•»*•***««**•»»»*«♦**«««♦***♦» ♦»*»»_ 

10871 

10872 
10373 

10874 

10875 

10876 

10877 

10878 

10879 

10880 
10881 
10882 

10883 

10884 
5"  ) 

10885 

10886 

10887 

10888 

10889 

10890 

10891 

10892 

10893 

10894 

10895  CALL  Fiber load(" 

10896  CALL  Fiberident 

10897  SUBEND 

ROUTINE  NAME  LINE  NUMBER 


This  routine  is  presently  inactive.  To  include  the  nearfield  lest  as 
a  test  option,  see  NRL  IR  Systemi  Operating  Manual  for  basic  needs. 

CALL  Cleardisplay 

PRINT  TABXY( 12 ,10)r'It  said  this  test  is  INACTIUE.  Can’t  you  read?" 
PRINT  TABXY(25,12)»"(0on’t  touch  that  dial!)" 

WAIT  4 
SUBEXIT 


Please  load  the  test  fiber.") 


[  The  real  progran  begins  here! 

CALL  Fiberloadi" 

CALL  Fiberident 
CALL  Askalign 

CALL  Nfieldvalsf "-35  to  -20.5  STEP  .5,-20  TO  20  STEP  2,20.5  TO  55  STEP  . 

CALL  Logtine 
CALL  Nfieldrun 
CALL  Nfleldplot 
SUBEND 
( 

I 

SUB  FibertestG 

'  FIBERTEST  SUBPROGRAM  NO.  6  —  FIBER  LOADING  &  IDENTIFICATION 
OA.  ,  ..  Please  load  the  test  fiber.") 


Mainprog  10 
Sysinit  334 
Systendaia  718 
TimeSfet  1726 
FNTinedateS  1900 
Logtinfe  1996 
Archivd  2022 
Retrieve  2308 
Zcdnter  2548 
Rundisplay  2532 
cieardieplay  2B08 
F2000ggnd  2630 
Preset  2736 
Egg5205comin  2930 
FNUoltndter  3016 


^  w 


,  i  >  w  >  i  V.  u\U 

Specwaves 

SetfocuB 

Specrun 

Spacref 

SpecmeaS 

Speocor 

Specatcomp 

Sp6c&ll Ist 

Specatplot 

Nf  ieldvals 

Nf ieldrun 

Nf ieldplot 

Cored! an 

Ffifeldvals 

Ff ieldrun 

Ffield  plot 

Nunaper 

Menu 

Serialno 

FNGetint 

FNGrating 

Askalign 

Init_foa_cntrl 

Ffnormal ise 

Ffdlff 

Ffcorrect 

FNGetudve 

A1  ign 

Stept^st 

Inalign 

Outalign 

Nfextwave 

Cleanup 

Dnarun 

Onaconp 

FNGfetreetrictor 
FNDatasource 
Dnaplotprgp 
Ff emooth 


Cleardsta 

Progliet 

Fibertesti  (Spftcatten) 
Fiberte6t2  (DMA) 
Fibertsat  3  (Far  Field) 
Fibertesi  4  (pinhole) 
Fiberteat  5  (near  fiaid) 
Fiberteat  S  (fiberload) 
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3866 
39B4 
4034 
4032 
4212 
4452 
4536 
4626 
4762 
5M4 
5196 
5324 
5534 
5614 
5708 
5878 
6434 
6564 
7738 
7766 
7832 
7862 
7910 
8160 
8250 
8306 
8346 
8368 
8608 
8688 
8970 
9252 
9456 
9493 
9732. 
9854 
10016 
10076 
10170 
10320 
10446 
10656 
10798 
10946 
11006 
I  1050 
1  1098 


